Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / vmsfil.mar < prev next >

Wrap

Text File | 1991-02-19 | 171.8 KB | 4,157 lines

; 0001 0 MODULE KERFIL (IDENT = '3.3.119', ; 0002 0 ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)) = ; 0003 1 BEGIN ; 0004 1 !<BLF/WIDTH:90> ; 0005 1 ; 0006 1 !++ ; 0007 1 ! FACILITY: ; 0008 1 ! KERMIT-32 Microcomputer to mainframe file transfer utility. ; 0009 1 ! ; 0010 1 ! ABSTRACT: ; 0011 1 ! KERFIL contains all of the file processing for KERMIT-32. This ; 0012 1 ! module contains the routines to input/output characters to files ; 0013 1 ! and to open and close the files. ; 0014 1 ! ; 0015 1 ! ENVIRONMENT: ; 0016 1 ! VAX/VMS user mode. ; 0017 1 ! ; 0018 1 ! AUTHOR: Robert C. McQueen, CREATION DATE: 28-March-1983 ; 0019 1 ! ; 0020 1 !-- ; 0021 1 ; 0022 1 %SBTTL 'Table of Contents' ; 0023 1 %SBTTL 'Revision History' ; 0024 1 ; 0025 1 !++ ; 0026 1 ! ; 0027 1 ! 1.0.000 By: Robert C. McQueen On: 28-March-1983 ; 0028 1 ! Create this module. ; 0029 1 ! 1.0.001 By: Robert C. McQueen On: 4-April-1983 ; 0030 1 ! Remove checks for <FF> in the input data stream. ; 0031 1 ! ; 0032 1 ! 1.0.002 By: Robert C. McQueen On: 31-May-1983 ; 0033 1 ! Fix a bad check in wildcard processing. ; 0034 1 ! ; 0035 1 ! 1.0.003 By: Nick Bush On: 13-June-1983 ; 0036 1 ! Add default file spec of .;0 so that wild-carded ; 0037 1 ! file types don't cause all version of a file to ; 0038 1 ! be transferred. ; 0039 1 ! ; 0040 1 ! 1.0.004 By: Robert C. McQueen On: 20-July-1983 ; 0041 1 ! Strip off the parity bit on the compares for incoming ASCII ; 0042 1 ! files. ; 0043 1 ! ; 0044 1 ! 1.2.005 By: Robert C. McQueen On: 15-August-1983 ; 0045 1 ! Attempt to improve the GET%FILE and make it smaller. ; 0046 1 ! Also start the implementation of the BLOCK file processing. ; 0047 1 ! ; 0048 1 ! 2.0.006 Release VAX/VMS Kermit-32 version 2.0 ; 0049 1 ! ; 0050 1 ! 2.0.016 By: Nick Bush On: 4-Dec-1983 ; 0051 1 ! Change how binary files are written to (hopefully) improve ; 0052 1 ! the performance. We will now use 510 records and only ; 0053 1 ! write out the record when it is filled (instead of writing ; 0054 1 ! one record per packet). This should cut down on the overhead ; 0055 1 ! substantially. ; 0056 1 ! ; 0057 1 ! 2.0.017 By: Nick Bush On: 9-Dec-1983 ; 0058 1 ! Fix processing for VFC format files. Also fix GET_ASCII ; 0059 1 ! for PRN and FTN record types. Change GET_ASCII so that ; 0060 1 ! 'normal' CR records get sent with trailing CRLF's instead ; 0061 1 ! of <LF>record<CR>. That was confusing too many people. ; 0062 1 ! ; 0063 1 ! 2.0.022 By: Nick Bush On: 15-Dec-1983 ; 0064 1 ! Add Fixed record size (512 byte) format for writing files. ; 0065 1 ! This can be used for .EXE files. Also clean up writing ; 0066 1 ! ASCII files so that we don't lose any characters. ; 0067 1 ! ; 0068 1 ! 2.0.024 By: Robert C. McQueen On: 19-Dec-1983 ; 0069 1 ! Delete FILE_DUMP. ; 0070 1 ! ; 0071 1 ! 2.0.026 By: Nick Bush On: 3-Jan-1983 ; 0072 1 ! Add options for format of file specification to be ; 0073 1 ! sent in file header packets. Also type out full file ; 0074 1 ! specification being sent/received instead of just ; 0075 1 ! the name we are telling the other end to use. ; 0076 1 ! ; 0077 1 ! 2.0.030 By: Nick Bush On: 3-Feb-1983 ; 0078 1 ! Add the capability of receiving a file with a different ; 0079 1 ! name than given by KERMSG. The RECEIVE and GET commands ; 0080 1 ! now really are different. ; 0081 1 ! ; 0082 1 ! 2.0.035 By: Nick Bush On: 8-March-1984 ; 0083 1 ! Add LOG SESSION command to set a log file for CONNECT. ; 0084 1 ! While we are doing so, clean up the command parsing a little ; 0085 1 ! so that we don't have as many COPY_xxx routines. ; 0086 1 ! ; 0087 1 ! 2.0.036 By: Nick Bush On: 15-March-1984 ; 0088 1 ! Fix PUT_FILE to correctly handle carriage returns which are ; 0089 1 ! not followed by line feeds. Count was being decremented ; 0090 1 ! Instead of incremented. ; 0091 1 ! ; 0092 1 ! 2.0.040 By: Nick Bush On: 22-March-1984 ; 0093 1 ! Fix processing of FORTRAN carriage control to handle lines ; 0094 1 ! which do not contain the carriage control character (i.e., zero ; 0095 1 ! length records). Previously, this type of record was sending ; 0096 1 ! infinite nulls. ; 0097 1 ! ; 0098 1 ! 3.0.045 Start of version 3. ; 0099 1 ! ; 0100 1 ! 3.0.046 By: Nick Bush On: 29-March-1984 ; 0101 1 ! Fix debugging log file to correctly set/clear file open ; 0102 1 ! flag. Also make log files default to .LOG. ; 0103 1 ! ; 0104 1 ! 3.0.050 By: Nick Bush On: 2-April-1984 ; 0105 1 ! Add SET SERVER_TIMER to determine period between idle naks. ; 0106 1 ! Also allow for a routine to process file specs before ; 0107 1 ! FILE_OPEN uses them. This allows individual sites to ; 0108 1 ! restrict the format of file specifications used by Kermit. ; 0109 1 ! ; 0110 1 ! 3.1.053 By: Robert C. McQueen On: 9-July-1984 ; 0111 1 ! Fix FORTRAN carriage control processing to pass along ; 0112 1 ! any character from the carriage control column that is ; 0113 1 ! not really carriage control. ; 0114 1 ! ; 0115 1 ! Start version 3.2 ; 0116 1 ! ; 0117 1 ! 3.2.067 By: Robert C. McQueen On: 8-May-1985 ; 0118 1 ! Use $GETDVIW instead of $GETDVI. ; 0119 1 ! ; 0120 1 ! 3.2.070 By: David Stevens On: 16-July-1985 ; 0121 1 ! Put "Sending: " prompt into NEXT_FILE routine, to make ; 0122 1 ! VMS KERMIT similar to KERMIT-10. ; 0123 1 ! ; 0124 1 ! 3.2.077 By: Robert McQueen On: 8-May-1986 ; 0125 1 ! Fix FORTRAN CC once and for all (I hope). ; 0126 1 ! ; 0127 1 ! Start of version 3.3 ; 0128 1 ! ; 0129 1 ! 3.3.105 By: Robert McQueen On: 8-July-1986 ; 0130 1 ! Do some clean up and attempt to fix LINK-W-TRUNC errors ; 0131 1 ! from a BLISS-32 bug. ; 0132 1 ! ; 0133 1 ! 3.3.106 By: Robert McQueen On: 8-July-1986 ; 0134 1 ! Fix problem of closing a fixed file and losing data. ; 0135 1 ! ; 0136 1 ! 3.3.111 By: Robert McQueen On: 2-Oct-1986 ; 0137 1 ! Make Kermit-32 not eat the parity from a CR if a LF doesn't ; 0138 1 ! follow it when writing an ASCII file. ; 0139 1 ! ; 0140 1 ! 3.3.112 JHW0001 Jonathan H. Welch, 28-Apr-1988 12:11 ; 0141 1 ! Fix the message generated in NEXT_FILE so that the ; 0142 1 ! filenames displayed (i.e. Sending: foo.bar;1 as foo.bar) ; 0143 1 ! are always terminated by a null (ASCIZ). ; 0144 1 ! ; 0145 1 ! 3.3.117 JHW006 Jonathan H. Welch, 12-May-1988 ; 0146 1 ! Calls to LIB$SIGNAL with multiple arguments were ; 0147 1 ! not coded correctly. For calls with multiple arguments ; 0148 1 ! an argument count was added. ; 0149 1 ! Minor changes to KERM_HANDLER to make use of the changed ; 0150 1 ! argument passing method. ; 0151 1 ! ; 0152 1 ! 3.3.118 JHW010 Jonathan H. Welch, 23-Apr-1990 09:42 ; 0153 1 ! Added SET FILE BLOCKSIZE nnn (where nnn is the record size ; 0154 1 ! in bytes) command for incoming BINARY and FIXED file transfers. ; 0155 1 ! If no blocksize has been specified the old behavior (510 byte ; 0156 1 ! records plus 2 bytes (for CR/LF) for BINARY files and 512 ; 0157 1 ! byte records for FIXED files will be used. ; 0158 1 ! Also modified SHOW FILE to display record size when appropriate. ; 0159 1 ! ; 0160 1 ! 3.3.119 JHW015 Jonathan H. Welch, 16-Jul-1990 15:30 ; 0161 1 ! Fixed the logic in GET_ASCII which was causing an infinite ; 0162 1 ! loop for files with print file carriage control. ; 0163 1 !-- ; 0164 1 ; 0165 1 %SBTTL 'Forward definitions' ; 0166 1 ; 0167 1 FORWARD ROUTINE ; 0168 1 LOG_PUT, ! Write a buffer out ; 0169 1 DUMP_BUFFER, ! Worker routine for FILE_DUMP. ; 0170 1 GET_BUFFER, ! Routine to do $GET ; 0171 1 GET_ASCII, ! Get an ASCII character ; 0172 1 GET_BLOCK, ! Get a block character ; 0173 1 FILE_ERROR : NOVALUE; ! Error processing routine ; 0174 1 ; 0175 1 %SBTTL 'Require/Library files' ; 0176 1 ! ; 0177 1 ! INCLUDE FILES: ; 0178 1 ! ; 0179 1 ; 0180 1 LIBRARY 'SYS$LIBRARY:STARLET'; ; 0181 1 ; 0182 1 REQUIRE 'KERCOM.REQ'; ; 0391 1 ; 0392 1 %SBTTL 'Macro definitions' ; 0393 1 ! ; 0394 1 ! MACROS: ; 0395 1 ! ; 0396 1 %SBTTL 'Literal symbol definitions' ; 0397 1 ! ; 0398 1 ! EQUATED SYMBOLS: ; 0399 1 ! ; 0400 1 ! ; 0401 1 ! Various states for reading the data from the file ; 0402 1 ! ; 0403 1 ; 0404 1 LITERAL ; 0405 1 F_STATE_PRE = 0, ! Prefix state ; 0406 1 F_STATE_PRE1 = 1, ! Other prefix state ; 0407 1 F_STATE_DATA = 2, ! Data processing state ; 0408 1 F_STATE_POST = 3, ! Postfix processing state ; 0409 1 F_STATE_POST1 = 4, ! Secondary postfix processing state ; 0410 1 F_STATE_MIN = 0, ! Min state number ; 0411 1 F_STATE_MAX = 4; ! Max state number ; 0412 1 ; 0413 1 ! ; 0414 1 ! Buffer size for log file ; 0415 1 ! ; 0416 1 ; 0417 1 LITERAL ; 0418 1 LOG_BUFF_SIZE = 256; ! Number of bytes in log file buffer ; 0419 1 ; 0420 1 %SBTTL 'Local storage' ; 0421 1 ! ; 0422 1 ! OWN STORAGE: ; 0423 1 ! ; 0424 1 ; 0425 1 OWN ; 0426 1 SEARCH_FLAG, ! Can/cannot do $SEARCH ; 0427 1 DEV_CLASS, ! Type of device we are reading ; 0428 1 EOF_FLAG, ! End of file reached. ; 0429 1 FILE_FAB : $FAB_DECL, ! FAB for file processing ; 0430 1 FILE_NAM : $NAM_DECL, ! NAM for file processing ; 0431 1 FILE_RAB : $RAB_DECL, ! RAB for file processing ; 0432 1 FILE_XABFHC : $XABFHC_DECL, ! XAB for file processing ; 0433 1 FILE_MODE, ! Mode of file (reading/writing) ; 0434 1 FILE_REC_POINTER, ! Pointer to the record information ; 0435 1 FILE_REC_COUNT, ! Count of the number of bytes ; 0436 1 REC_SIZE : LONG, ! Record size ; 0437 1 REC_ADDRESS : LONG, ! Record address ; 0438 1 FIX_SIZE : LONG, ! Fixed control region size ; 0439 1 FIX_ADDRESS : LONG, ! Address of buffer for fixed control region ; 0440 1 EXP_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], ; 0441 1 RES_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], ; 0442 1 RES_STR_D : BLOCK [8, BYTE]; ! Descriptor for the string ; 0443 1 ; 0444 1 %SBTTL 'Global storage' ; 0445 1 ! ; 0446 1 ! Global storage: ; 0447 1 ! ; 0448 1 ; 0449 1 GLOBAL ; 0450 1 ; 0451 1 file_blocksize, ! Block size of for BINARY and FIXED files. ; 0452 1 file_blocksize_set, ! 0=user has not specified a blocksize, 1=user has specified a blocksize ; 0453 1 FILE_TYPE, ! Type of file being xfered ; 0454 1 FILE_DESC : BLOCK [8, BYTE]; ! File name descriptor ; 0455 1 ; 0456 1 %SBTTL 'External routines and storage' ; 0457 1 ! ; 0458 1 ! EXTERNAL REFERENCES: ; 0459 1 ! ; 0460 1 ! ; 0461 1 ! Storage in KERMSG ; 0462 1 ! ; 0463 1 ; 0464 1 EXTERNAL ; 0465 1 ALT_FILE_SIZE, ! Number of characters in FILE_NAME ; 0466 1 ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ! Storage ; 0467 1 FILE_SIZE, ! Number of characters in FILE_NAME ; 0468 1 FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ; 0469 1 TY_FIL, ! Flag that file names are being typed ; 0470 1 CONNECT_FLAG, ! Indicator of whether we have a terminal to type on ; 0471 1 FIL_NORMAL_FORM; ! File specification type ; 0472 1 ; 0473 1 ! ; 0474 1 ! Routines in KERTT ; 0475 1 ! ; 0476 1 ; 0477 1 EXTERNAL ROUTINE ; 0478 1 TT_OUTPUT : NOVALUE; ! Force buffered output ; 0479 1 ; 0480 1 ! ; 0481 1 ! System libraries ; 0482 1 ! ; 0483 1 ; 0484 1 EXTERNAL ROUTINE ; 0485 1 LIB$GET_VM : ADDRESSING_MODE (GENERAL), ; 0486 1 LIB$FREE_VM : ADDRESSING_MODE (GENERAL), ; 0487 1 LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; ; 0488 1 ; 0489 1 %SBTTL 'File processing -- FILE_INIT - Initialization' ; 0490 1 ; 0491 1 GLOBAL ROUTINE FILE_INIT : NOVALUE = ; 0492 1 ; 0493 1 !++ ; 0494 1 ! FUNCTIONAL DESCRIPTION: ; 0495 1 ! ; 0496 1 ! This routine will initialize some of the storage in the file processing ; 0497 1 ! module. ; 0498 1 ! ; 0499 1 ! CALLING SEQUENCE: ; 0500 1 ! ; 0501 1 ! FILE_INIT(); ; 0502 1 ! ; 0503 1 ! INPUT PARAMETERS: ; 0504 1 ! ; 0505 1 ! None. ; 0506 1 ! ; 0507 1 ! IMPLICIT INPUTS: ; 0508 1 ! ; 0509 1 ! None. ; 0510 1 ! ; 0511 1 ! OUTPUT PARAMETERS: ; 0512 1 ! ; 0513 1 ! None. ; 0514 1 ! ; 0515 1 ! IMPLICIT OUTPUTS: ; 0516 1 ! ; 0517 1 ! None. ; 0518 1 ! ; 0519 1 ! COMPLETION CODES: ; 0520 1 ! ; 0521 1 ! None. ; 0522 1 ! ; 0523 1 ! SIDE EFFECTS: ; 0524 1 ! ; 0525 1 ! None. ; 0526 1 ! ; 0527 1 !-- ; 0528 1 ; 0529 2 BEGIN ; 0530 2 FILE_TYPE = FILE_ASC; ; 0531 2 file_blocksize = 512; ; 0532 2 file_blocksize_set = 0; ; 0533 2 ; 0534 2 ! Now set up the file specification descriptor ; 0535 2 FILE_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0536 2 FILE_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0537 2 FILE_DESC [DSC$A_POINTER] = FILE_NAME; ; 0538 2 FILE_DESC [DSC$W_LENGTH] = 0; ; 0539 2 EOF_FLAG = FALSE; ; 0540 1 END; ! End of FILE_INIT .TITLE KERFIL .IDENT \3.3.119\ .PSECT $OWN$,NOEXE,2 ;SEARCH_FLAG U.7: .BLKB 4 ; 00000 ;DEV_CLASS U.8: .BLKB 4 ; 00004 ;EOF_FLAG U.9: .BLKB 4 ; 00008 ;FILE_FAB U.10: .BLKB 80 ; 0000C ;FILE_NAM U.11: .BLKB 96 ; 0005C ;FILE_RAB U.12: .BLKB 68 ; 000BC ;FILE_XABFHC U.13: .BLKB 44 ; 00100 ;FILE_MODE U.14: .BLKB 4 ; 0012C ;FILE_REC_POINTER U.15: .BLKB 4 ; 00130 ;FILE_REC_COUNT U.16: .BLKB 4 ; 00134 ;REC_SIZE U.17: .BLKB 4 ; 00138 ;REC_ADDRESS U.18: .BLKB 4 ; 0013C ;FIX_SIZE U.19: .BLKB 4 ; 00140 ;FIX_ADDRESS U.20: .BLKB 4 ; 00144 ;EXP_STR U.21: .BLKB 256 ; 00148 ;RES_STR U.22: .BLKB 256 ; 00248 ;RES_STR_D U.23: .BLKB 8 ; 00348 .PSECT $GLOBAL$,NOEXE,2 FILE_BLOCKSIZE:: .BLKB 4 ; 00000 FILE_BLOCKSIZE_SET:: .BLKB 4 ; 00004 FILE_TYPE:: .BLKB 4 ; 00008 FILE_DESC:: .BLKB 8 ; 0000C FNM_NORMAL== 1 FNM_FULL== 2 FNM_UNTRAN== 4 PR_MIN== 0 PR_NONE== 0 PR_MARK== 1 PR_EVEN== 2 PR_ODD== 3 PR_SPACE== 4 PR_MAX== 4 GC_MIN== 1 GC_EXIT== 1 GC_DIRECTORY== 2 GC_DISK_USAGE== 3 GC_DELETE== 4 GC_TYPE== 5 GC_HELP== 6 GC_LOGOUT== 7 GC_LGN== 8 GC_CONNECT== 9 GC_RENAME== 10 GC_COPY== 11 GC_WHO== 12 GC_SEND_MSG== 13 GC_STATUS== 14 GC_COMMAND== 15 GC_KERMIT== 16 GC_JOURNAL== 17 GC_VARIABLE== 18 GC_PROGRAM== 19 GC_MAX== 19 DP_FULL== 0 DP_HALF== 1 CHK_1CHAR== 49 CHK_2CHAR== 50 CHK_CRC== 51 MAX_MSG== 1002 .EXTRN ALT_FILE_SIZE, ALT_FILE_NAME, FILE_SIZE, FILE_NAME, TY_FIL, CONNECT_FLAG, FIL_NORMAL_FORM .EXTRN TT_OUTPUT, LIB$GET_VM, LIB$FREE_VM, LIB$SIGNAL .PSECT $CODE$,NOWRT,2 .ENTRY FILE_INIT, ^M<R2> ;FILE_INIT, Save R2 0491 0004 00000 MOVAB G^FILE_TYPE, R2 ;FILE_TYPE, R2 52 00000000' 00 9E 00002 MOVL #1, (R2) ;#1, FILE_TYPE 0530 62 01 D0 00009 MOVZWL #512, -8(R2) ;#512, FILE_BLOCKSIZE 0531 F8 A2 0200 8F 3C 0000C CLRL -4(R2) ;FILE_BLOCKSIZE_SET 0532 FC A2 D4 00012 MOVL #17694720, 4(R2) ;#17694720, FILE_DESC 0538 04 A2 010E0000 8F D0 00015 MOVAB G^FILE_NAME, 8(R2) ;FILE_NAME, FILE_DESC+4 0537 08 A2 00000000G 00 9E 0001D CLRL G^U.9 ;U.9 0539 00000000' 00 D4 00025 RET ; 0540 04 0002B ; Routine Size: 44 bytes, Routine Base: $CODE$ + 0000 ; 0541 1 ; 0542 1 %SBTTL 'GET_FILE' ; 0543 1 ; 0544 1 GLOBAL ROUTINE GET_FILE (CHARACTER) = ; 0545 1 ; 0546 1 !++ ; 0547 1 ! FUNCTIONAL DESCRIPTION: ; 0548 1 ! ; 0549 1 ! This routine will return a character from the input file. ; 0550 1 ! The character will be stored into the location specified by ; 0551 1 ! CHARACTER. ; 0552 1 ! ; 0553 1 ! CALLING SEQUENCE: ; 0554 1 ! ; 0555 1 ! GET_FILE (LOCATION_TO_STORE_CHAR); ; 0556 1 ! ; 0557 1 ! INPUT PARAMETERS: ; 0558 1 ! ; 0559 1 ! LOCATION_TO_STORE_CHAR - This is the address to store the character ; 0560 1 ! into. ; 0561 1 ! ; 0562 1 ! IMPLICIT INPUTS: ; 0563 1 ! ; 0564 1 ! None. ; 0565 1 ! ; 0566 1 ! OUTPUT PARAMETERS: ; 0567 1 ! ; 0568 1 ! Character stored into the location specified. ; 0569 1 ! ; 0570 1 ! IMPLICIT OUTPUTS: ; 0571 1 ! ; 0572 1 ! None. ; 0573 1 ! ; 0574 1 ! COMPLETION CODES: ; 0575 1 ! ; 0576 1 ! True - Character stored into the location specified. ; 0577 1 ! False - End of file reached. ; 0578 1 ! ; 0579 1 ! SIDE EFFECTS: ; 0580 1 ! ; 0581 1 ! None. ; 0582 1 ! ; 0583 1 !-- ; 0584 1 ; 0585 2 BEGIN ; 0586 2 ! ; 0587 2 ! Define the various condition codes that we check for in this routine ; 0588 2 ! ; 0589 2 EXTERNAL LITERAL ; 0590 2 KER_EOF; ! End of file ; 0591 2 ; 0592 2 LOCAL ; 0593 2 STATUS; ! Random status values ; 0594 2 ; 0595 2 IF .EOF_FLAG THEN RETURN KER_EOF; ; 0596 2 ; 0597 2 SELECTONE .FILE_TYPE OF ; 0598 2 SET ; 0599 2 ; 0600 2 [FILE_ASC, FILE_BIN, FILE_FIX] : ; 0601 2 STATUS = GET_ASCII (.CHARACTER); ; 0602 2 ; 0603 2 [FILE_BLK] : ; 0604 2 STATUS = GET_BLOCK (.CHARACTER); ; 0605 2 TES; ; 0606 2 ; 0607 2 RETURN .STATUS; ; 0608 1 END; ! End of GET_FILE .EXTRN KER_EOF .ENTRY GET_FILE, ^M<> ;GET_FILE, Save nothing 0544 0000 00000 BLBC G^U.9, 1$ ;U.9, 1$ 0595 08 00000000' 00 E9 00002 MOVL #KER_EOF, R0 ;#KER_EOF, R0 50 00000000G 8F D0 00009 RET ; 04 00010 1$: MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 0597 50 00000000' 00 D0 00011 BLEQ 2$ ;2$ 0600 05 15 00018 CMPL R0, #2 ;R0, #2 02 50 D1 0001A BLEQ 3$ ;3$ 05 15 0001D 2$: CMPL R0, #4 ;R0, #4 04 50 D1 0001F BNEQ 4$ ;4$ 0B 12 00022 3$: PUSHL 4(AP) ;CHARACTER 0601 04 AC DD 00024 CALLS #1, G^U.4 ;#1, U.4 00000000V 00 01 FB 00027 RET ; 04 0002E 4$: CMPL R0, #3 ;R0, #3 0603 03 50 D1 0002F BNEQ 5$ ;5$ 0A 12 00032 PUSHL 4(AP) ;CHARACTER 0604 04 AC DD 00034 CALLS #1, G^U.5 ;#1, U.5 00000000V 00 01 FB 00037 5$: RET ; 0607 04 0003E ; Routine Size: 63 bytes, Routine Base: $CODE$ + 002C ; 0609 1 %SBTTL 'GET_ASCII - Get a character from an ASCII file' ; 0610 1 ROUTINE GET_ASCII (CHARACTER) = ; 0611 1 ; 0612 1 !++ ; 0613 1 ! FUNCTIONAL DESCRIPTION: ; 0614 1 ! ; 0615 1 ! CALLING SEQUENCE: ; 0616 1 ! ; 0617 1 ! INPUT PARAMETERS: ; 0618 1 ! ; 0619 1 ! None. ; 0620 1 ! ; 0621 1 ! IMPLICIT INPUTS: ; 0622 1 ! ; 0623 1 ! None. ; 0624 1 ! ; 0625 1 ! OUPTUT PARAMETERS: ; 0626 1 ! ; 0627 1 ! None. ; 0628 1 ! ; 0629 1 ! IMPLICIT OUTPUTS: ; 0630 1 ! ; 0631 1 ! None. ; 0632 1 ! ; 0633 1 ! COMPLETION CODES: ; 0634 1 ! ; 0635 1 ! KER_EOF - End of file encountered ; 0636 1 ! KER_ILLFILTYP - Illegal file type ; 0637 1 ! KER_NORMAL - Normal return ; 0638 1 ! ; 0639 1 ! SIDE EFFECTS: ; 0640 1 ! ; 0641 1 ! None. ; 0642 1 ! ; 0643 1 !-- ; 0644 1 ; 0645 2 BEGIN ; 0646 2 ! ; 0647 2 ! Status codes that are returned by this module ; 0648 2 ! ; 0649 2 EXTERNAL LITERAL ; 0650 2 KER_EOF, ! End of file encountered ; 0651 2 KER_ILLFILTYP, ! Illegal file type ; 0652 2 KER_NORMAL; ! Normal return ; 0653 2 ; 0654 2 OWN ; 0655 2 CC_COUNT, ! Count of the number of CC things to output ; 0656 2 CC_TYPE; ! Type of carriage control being processed. ; 0657 2 ; 0658 2 LOCAL ; 0659 2 STATUS, ! For status values ; 0660 2 RAT; ; 0661 2 %SBTTL 'GET_FTN_FILE_CHARACTER - Get a character from an Fortran carriage control file' ; 0662 2 ROUTINE GET_FTN_FILE_CHARACTER (CHARACTER) = ; 0663 2 !++ ; 0664 2 ! FUNCTIONAL DESCRIPTION: ; 0665 2 ! ; 0666 2 ! This routine will get a character from a FORTRAN carriage control file. ; 0667 2 ! A FORTRAN carriage control file is one with FAB$M_FTN on in the FAB$B_RAT ; 0668 2 ! field. ; 0669 2 ! ; 0670 2 ! FORMAL PARAMETERS: ; 0671 2 ! ; 0672 2 ! CHARACTER - Address of where to store the character ; 0673 2 ! ; 0674 2 ! IMPLICIT INPUTS: ; 0675 2 ! ; 0676 2 ! CC_TYPE - Carriage control type ; 0677 2 ! ; 0678 2 ! IMPLICIT OUTPUTS: ; 0679 2 ! ; 0680 2 ! CC_TYPE - Updated if this is the first characte of the record ; 0681 2 ! ; 0682 2 ! COMPLETION_CODES: ; 0683 2 ! ; 0684 2 ! System service or Kermit status code ; 0685 2 ! ; 0686 2 ! SIDE EFFECTS: ; 0687 2 ! ; 0688 2 ! Next buffer can be read from the data file. ; 0689 2 !-- ; 0690 3 BEGIN ; 0691 3 ! ; 0692 3 ! Dispatch according to the state of the file being read. Beginning of ; 0693 3 ! record, middle of record, end of record ; 0694 3 ! ; 0695 3 WHILE TRUE DO ; 0696 3 CASE .FILE_FAB[FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF ; 0697 3 SET ; 0698 3 ! ; 0699 3 ! Here at the beginning of a record. We must read the buffer from the file ; 0700 3 ! at this point. Once the buffer is read we must then determine what to do ; 0701 3 ! with the FORTRAN carriage control that at the beginning of the buffer. ; 0702 3 ! ; 0703 3 [F_STATE_PRE ]: ; 0704 4 BEGIN ; 0705 4 ! ; 0706 4 ! Local variables ; 0707 4 ! ; 0708 4 LOCAL ; 0709 4 STATUS; ! Status returned by the ; 0710 4 ! GET_BUFFER routine ; 0711 4 ! ; 0712 4 ! Get the buffer ; 0713 4 ! ; 0714 4 STATUS = GET_BUFFER (); ! Get a buffer from the system ; 0715 5 IF (NOT .STATUS) ! If this call failed ; 0716 5 OR (.STATUS EQL KER_EOF) ! or we got an EOF ; 0717 4 THEN ; 0718 4 RETURN .STATUS; ! Just return the status ; 0719 4 ! ; 0720 4 ! Here with a valid buffer full of data all set to be decoded ; 0721 4 ! ; 0722 4 IF .FILE_REC_COUNT LEQ 0 ! If nothing, use a space ; 0723 4 THEN ! for the carriage control ; 0724 4 CC_TYPE = %C' ' ; 0725 4 ELSE ; 0726 5 BEGIN ; 0727 5 CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER); ; 0728 5 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0729 4 END; ; 0730 4 ! ; 0731 4 ! Dispatch on the type of carriage control that we are processing ; 0732 4 ! ; 0733 4 SELECTONE .CC_TYPE OF ; 0734 4 SET ; 0735 4 ! ; 0736 4 ! All of these just output: ; 0737 4 ! <DATA> <Carriage-control> ; 0738 4 ! ; 0739 4 [CHR_NUL, %C'+'] : ; 0740 5 BEGIN ; 0741 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0742 4 END; ; 0743 4 ! ; 0744 4 ! This outputs: ; 0745 4 ! <LF><DATA><CR> ; 0746 4 ! ; 0747 4 [%C'$', %C' '] : ; 0748 5 BEGIN ; 0749 5 .CHARACTER = CHR_LFD; ; 0750 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0751 5 RETURN KER_NORMAL; ; 0752 4 END; ; 0753 4 ! ; 0754 4 ! This outputs: ; 0755 4 ! <LF><LF><DATA><CR> ; 0756 4 ! ; 0757 4 [%C'0'] : ; 0758 5 BEGIN ; 0759 5 .CHARACTER = CHR_LFD; ; 0760 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1; ; 0761 5 RETURN KER_NORMAL; ; 0762 4 END; ; 0763 4 ! ; 0764 4 ! This outputs: ; 0765 4 ! <FORM FEED><DATA><CR> ; 0766 4 ! ; 0767 4 [%C'1'] : ; 0768 5 BEGIN ; 0769 5 .CHARACTER = CHR_FFD; ; 0770 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0771 5 RETURN KER_NORMAL; ; 0772 4 END; ; 0773 4 ! ; 0774 4 ! If we don't know the type of carriage control, then just return the ; 0775 4 ! character we read as data and set the carriage control to be space ; 0776 4 ! to fool the post processing of the record ; 0777 4 ! ; 0778 4 [OTHERWISE] : ; 0779 5 BEGIN ; 0780 5 .CHARACTER = .CC_TYPE; ! Return the character ; 0781 5 CC_TYPE = %C' '; ! Treat as space ; 0782 5 FILE_REC_POINTER = CH$PLUS(.FILE_REC_POINTER,-1); ; 0783 5 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 0784 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0785 5 RETURN KER_NORMAL ; 0786 4 END; ; 0787 4 TES; ; 0788 4 ; 0789 3 END; ; 0790 3 ! ; 0791 3 ! Here to add the second LF for the double spacing FORTRAN carriage control ; 0792 3 ! ; 0793 3 [F_STATE_PRE1 ]: ; 0794 4 BEGIN ; 0795 4 .CHARACTER = CHR_LFD; ; 0796 4 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0797 4 RETURN KER_NORMAL; ; 0798 3 END; ; 0799 3 ! ; 0800 3 ! Here to read the data of the record ; 0801 3 ! ; 0802 3 [F_STATE_DATA]: ; 0803 4 BEGIN ; 0804 4 ! ; 0805 4 ! Here to read the data of the record and return it to the caller ; 0806 4 ! This section can only return KER_NORMAL to the caller ; 0807 4 ! ; 0808 4 IF .FILE_REC_COUNT LEQ 0 ! Anything left in the buffer ; 0809 4 THEN ; 0810 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST ! No, do post processing ; 0811 4 ELSE ; 0812 5 BEGIN ; 0813 5 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ! Get a character ; 0814 5 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ! Decrement the count ; 0815 5 RETURN KER_NORMAL; ! Give a good return ; 0816 4 END; ; 0817 3 END; ; 0818 3 ! ; 0819 3 ! Here to do post processing of the record. At this point we are going ; 0820 3 ! to store either nothing as the post fix, a carriage return for overprinting ; 0821 3 ! or a carriage return and then a line feed in the POST1 state. ; 0822 3 ! ; 0823 3 [F_STATE_POST ]: ; 0824 4 BEGIN ; 0825 4 SELECTONE .CC_TYPE OF ; 0826 4 SET ; 0827 4 ! ; 0828 4 ! This stat is for no carriage control on the record. This is for ; 0829 4 ! 'null' carriage control (VMS manual states: "Null carriage control ; 0830 4 ! (print buffer contents.)" and for prompt carriage control. ; 0831 4 ! ; 0832 4 [CHR_NUL, %C'$' ]: ; 0833 5 BEGIN ; 0834 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE ; 0835 4 END; ; 0836 4 ! ; 0837 4 ! This is the normal state, that causes the postfix for the data to be ; 0838 4 ! a line feed. ; 0839 4 ! ; 0840 4 [%C'0', %C'1', %C' ', %C'+' ]: ; 0841 5 BEGIN ; 0842 5 .CHARACTER = CHR_CRT; ; 0843 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0844 5 RETURN KER_NORMAL ; 0845 4 END; ; 0846 4 TES; ; 0847 4 ; 0848 3 END; ; 0849 3 ! ; 0850 3 ! Here if we are in a state that this routine doesn't set. Just assume that ; 0851 3 ! something screwed up and give an illegal file type return to the caller ; 0852 3 ! ; 0853 3 [INRANGE, OUTRANGE]: ; 0854 3 RETURN KER_ILLFILTYP; ; 0855 3 ; 0856 3 TES ; 0857 2 END; .PSECT $OWN$,NOEXE,2 ;CC_COUNT U.30: .BLKB 4 ; 00350 ;CC_TYPE U.31: .BLKB 4 ; 00354 .EXTRN KER_ILLFILTYP, KER_NORMAL .PSECT $CODE$,NOWRT,2 ;GET_FTN_FILE_CHARACTER U.32: .WORD ^M<R2> ;Save R2 0662 0004 00000 MOVAB G^U.10+24, R2 ;U.10+24, R2 52 00000000' 00 9E 00002 1$: CASEL (R2), #0, #4 ;FILE_FAB+24, #0, #4 0696 00 62 CF 00009 ; 04 0000C 2$: .WORD 4$-2$,- ;4$-2$,- 008D 0012 0000D 14$-2$,- ;14$-2$,- 00B4 0096 00011 16$-2$,- ;16$-2$,- 000A 00015 18$-2$,- ;18$-2$,- 3$-2$ ;3$-2$ 3$: MOVL #KER_ILLFILTYP, R0 ;#KER_ILLFILTYP, R0 0854 50 00000000G 8F D0 00017 RET ; 04 0001E 4$: CALLS #0, G^U.3 ;#0, U.3 0714 00000000V 00 00 FB 0001F BLBS R0, 5$ ;STATUS, 5$ 0715 01 50 E8 00026 RET ; 04 00029 5$: CMPL R0, #KER_EOF ;STATUS, #KER_EOF 0716 00000000G 8F 50 D1 0002A BNEQ 6$ ;6$ 01 12 00031 RET ; 04 00033 6$: TSTL 272(R2) ;FILE_REC_COUNT 0722 0110 C2 D5 00034 BGTR 7$ ;7$ 07 14 00038 MOVL #32, 816(R2) ;#32, CC_TYPE 0724 0330 C2 20 D0 0003A BRB 8$ ;8$ 12 11 0003F 7$: MOVL 268(R2), R0 ;FILE_REC_POINTER, R0 0727 50 010C C2 D0 00041 MOVZBL (R0), 816(R2) ;(R0), CC_TYPE 0330 C2 60 9A 00046 INCL 268(R2) ;FILE_REC_POINTER 010C C2 D6 0004B DECL 272(R2) ;FILE_REC_COUNT 0728 0110 C2 D7 0004F 8$: MOVL 816(R2), R0 ;CC_TYPE, R0 0733 50 0330 C2 D0 00053 BEQL 9$ ;9$ 0739 05 13 00058 CMPL R0, #43 ;R0, #43 2B 50 D1 0005A BNEQ 11$ ;11$ 05 12 0005D 9$: MOVL #2, (R2) ;#2, FILE_FAB+24 0741 62 02 D0 0005F 10$: BRB 1$ ;1$ A5 11 00062 11$: CMPL R0, #32 ;R0, #32 0747 20 50 D1 00064 BEQL 14$ ;14$ 31 13 00067 CMPL R0, #36 ;R0, #36 24 50 D1 00069 BEQL 14$ ;14$ 2C 13 0006C CMPL R0, #48 ;R0, #48 0757 30 50 D1 0006E BNEQ 12$ ;12$ 09 12 00071 MOVL #10, @4(AP) ;#10, @CHARACTER 0759 04 BC 0A D0 00073 MOVL #1, (R2) ;#1, FILE_FAB+24 0760 62 01 D0 00077 BRB 22$ ;22$ 0761 72 11 0007A 12$: CMPL R0, #49 ;R0, #49 0767 31 50 D1 0007C BNEQ 13$ ;13$ 06 12 0007F MOVL #12, @4(AP) ;#12, @CHARACTER 0769 04 BC 0C D0 00081 BRB 15$ ;15$ 0770 17 11 00085 13$: MOVL R0, @4(AP) ;R0, @CHARACTER 0780 04 BC 50 D0 00087 MOVL #32, 816(R2) ;#32, CC_TYPE 0781 0330 C2 20 D0 0008B DECL 268(R2) ;FILE_REC_POINTER 0782 010C C2 D7 00090 INCL 272(R2) ;FILE_REC_COUNT 0783 0110 C2 D6 00094 BRB 15$ ;15$ 0784 04 11 00098 14$: MOVL #10, @4(AP) ;#10, @CHARACTER 0795 04 BC 0A D0 0009A 15$: MOVL #2, (R2) ;#2, FILE_FAB+24 0796 62 02 D0 0009E BRB 22$ ;22$ 0797 4B 11 000A1 16$: TSTL 272(R2) ;FILE_REC_COUNT 0808 0110 C2 D5 000A3 BGTR 17$ ;17$ 05 14 000A7 MOVL #3, (R2) ;#3, FILE_FAB+24 0810 62 03 D0 000A9 BRB 10$ ;10$ B4 11 000AC 17$: MOVL 268(R2), R0 ;FILE_REC_POINTER, R0 0813 50 010C C2 D0 000AE MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 000B3 INCL 268(R2) ;FILE_REC_POINTER 010C C2 D6 000B7 DECL 272(R2) ;FILE_REC_COUNT 0814 0110 C2 D7 000BB BRB 22$ ;22$ 0815 2D 11 000BF 18$: MOVL 816(R2), R0 ;CC_TYPE, R0 0825 50 0330 C2 D0 000C1 BEQL 19$ ;19$ 0832 05 13 000C6 CMPL R0, #36 ;R0, #36 24 50 D1 000C8 BNEQ 20$ ;20$ 04 12 000CB 19$: CLRL (R2) ;FILE_FAB+24 0834 62 D4 000CD BRB 10$ ;10$ 91 11 000CF 20$: CMPL R0, #32 ;R0, #32 0840 20 50 D1 000D1 BEQL 21$ ;21$ 12 13 000D4 CMPL R0, #43 ;R0, #43 2B 50 D1 000D6 BEQL 21$ ;21$ 0D 13 000D9 CMPL R0, #48 ;R0, #48 30 50 D1 000DB BLSS 10$ ;10$ 82 19 000DE CMPL R0, #49 ;R0, #49 31 50 D1 000E0 BLEQ 21$ ;21$ 03 15 000E3 BRW 1$ ;1$ FF21 31 000E5 21$: MOVL #13, @4(AP) ;#13, @CHARACTER 0842 04 BC 0D D0 000E8 CLRL (R2) ;FILE_FAB+24 0843 62 D4 000EC 22$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 0844 50 00000000G 8F D0 000EE RET ; 0857 04 000F5 ; Routine Size: 246 bytes, Routine Base: $CODE$ + 006B ; 0858 2 %SBTTL 'GET_ASCII - Main logic' ; 0859 2 RAT = .FILE_FAB [FAB$B_RAT] AND ( NOT FAB$M_BLK); ; 0860 2 ; 0861 2 IF .DEV_CLASS EQL DC$_MAILBOX THEN RAT = FAB$M_CR; ! Mailbox needs CR's ; 0862 2 ; 0863 2 WHILE TRUE DO ; 0864 3 BEGIN ; 0865 3 ; 0866 3 SELECTONE .RAT OF ; 0867 3 SET ; 0868 3 ; 0869 3 [FAB$M_FTN ]: ; 0870 4 BEGIN ; 0871 4 RETURN GET_FTN_FILE_CHARACTER (.CHARACTER) ; 0872 3 END; ; 0873 3 ; 0874 3 [FAB$M_PRN, FAB$M_CR] : ; 0875 3 ; 0876 3 CASE .FILE_FAB [FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF ; 0877 3 SET ; 0878 3 ; 0879 3 [F_STATE_PRE] : ; 0880 4 BEGIN ; 0881 4 STATUS = GET_BUFFER (); ; 0882 4 ; 0883 4 IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS; ; 0884 4 ; 0885 4 SELECTONE .RAT OF ; 0886 4 SET ; 0887 4 ; 0888 4 [FAB$M_CR] : ; 0889 5 BEGIN ; 0890 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0891 4 END; ; 0892 4 ; 0893 4 [FAB$M_PRN] : ; 0894 5 BEGIN ; 0895 5 ; 0896 5 LOCAL ; 0897 5 TEMP_POINTER; ; 0898 5 ; 0899 5 TEMP_POINTER = CH$PTR (.FILE_RAB [RAB$L_RHB]); ; 0900 5 CC_COUNT = CH$RCHAR_A (TEMP_POINTER); ; 0901 5 CC_TYPE = CH$RCHAR_A (TEMP_POINTER); ; 0902 5 ; 0903 5 IF .CC_COUNT<7, 1> EQL 0 ; 0904 5 THEN ; 0905 6 BEGIN ; 0906 6 ; 0907 6 IF .CC_COUNT<0, 7> NEQ 0 ; 0908 6 THEN ; 0909 7 BEGIN ; 0910 7 .CHARACTER = CHR_LFD; ; 0911 7 CC_COUNT = .CC_COUNT - 1; ; 0912 7 ; 0913 7 IF .CC_COUNT GTR 0 ; 0914 7 THEN ; 0915 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1 ; 0916 7 ELSE ; 0917 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0918 7 ; 0919 7 RETURN KER_NORMAL; ; 0920 7 END ; 0921 6 ELSE ; 0922 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0923 6 ; 0924 6 END ; 0925 5 ELSE ; 0926 6 BEGIN ; 0927 6 ; 0928 6 SELECTONE .CC_COUNT<5, 2> OF ; 0929 6 SET ; 0930 6 ; 0931 6 [%B'00'] : ; 0932 7 BEGIN ; 0933 7 .CHARACTER = .CC_COUNT<0, 5>; ; 0934 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0935 7 RETURN KER_NORMAL; ; 0936 6 END; ; 0937 6 ; 0938 6 [%B'10'] : ; 0939 7 BEGIN ; 0940 7 .CHARACTER = .CC_COUNT<0, 5> + 128; ; 0941 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0942 7 RETURN KER_NORMAL; ; 0943 6 END; ; 0944 6 ; 0945 6 [OTHERWISE, %B'11'] : ; 0946 6 RETURN KER_ILLFILTYP; ; 0947 6 TES; ; 0948 5 END; ; 0949 4 END; ; 0950 4 TES; ; 0951 4 ; 0952 3 END; ; 0953 3 ; 0954 3 [F_STATE_PRE1] : ; 0955 3 ; 0956 3 IF .RAT EQL FAB$M_PRN ; 0957 3 THEN ; 0958 4 BEGIN ; 0959 4 .CHARACTER = CHR_LFD; ; 0960 4 CC_COUNT = .CC_COUNT - 1; ; 0961 4 ; 0962 4 IF .CC_COUNT LEQ 0 THEN FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0963 4 ; 0964 4 RETURN KER_NORMAL; ; 0965 4 END ; 0966 3 ELSE ; 0967 3 RETURN KER_ILLFILTYP; ; 0968 3 ; 0969 3 [F_STATE_DATA] : ; 0970 4 BEGIN ; 0971 4 ; 0972 4 IF .FILE_REC_COUNT LEQ 0 ; 0973 4 THEN ; 0974 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST ; 0975 4 ELSE ; 0976 5 BEGIN ; 0977 5 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0978 5 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0979 5 RETURN KER_NORMAL; ; 0980 4 END; ; 0981 4 ; 0982 3 END; ; 0983 3 ; 0984 3 [F_STATE_POST] : ; 0985 4 BEGIN ; 0986 4 ; 0987 4 SELECTONE .RAT OF ; 0988 4 SET ; 0989 4 ; 0990 4 [FAB$M_CR] : ; 0991 5 BEGIN ; 0992 5 .CHARACTER = CHR_CRT; ; 0993 5 FILE_FAB [FAB$L_CTX] = F_STATE_POST1; ; 0994 5 ! So we get a line feed ; 0995 5 RETURN KER_NORMAL; ; 0996 4 END; ; 0997 4 ; 0998 4 ; 0999 4 [FAB$M_PRN] : ; 1000 5 BEGIN ; 1001 5 ; 1002 5 IF .CC_TYPE<7, 1> EQL 0 ; 1003 5 THEN ; 1004 6 BEGIN ; 1005 6 ; 1006 6 IF .CC_TYPE<0, 7> NEQ 0 ; 1007 6 THEN ; 1008 7 BEGIN ; 1009 7 .CHARACTER = CHR_LFD; ; 1010 7 CC_COUNT = .CC_TYPE; ; 1011 7 FILE_FAB [FAB$L_CTX] = F_STATE_POST1; ; 1012 7 RETURN KER_NORMAL; ; 1013 7 END ; 1014 6 ELSE ; 1015 6 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1016 6 END ; 1017 5 ELSE ; 1018 6 BEGIN ; 1019 6 ; 1020 6 SELECTONE .CC_TYPE<5, 2> OF ; 1021 6 SET ; 1022 6 ; 1023 6 [%B'00'] : ; 1024 7 BEGIN ; 1025 7 .CHARACTER = .CC_TYPE<0, 5>; ; 1026 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1027 7 RETURN KER_NORMAL; ; 1028 6 END; ; 1029 6 ; 1030 6 [%B'10'] : ; 1031 7 BEGIN ; 1032 7 .CHARACTER = .CC_TYPE<0, 5> + 128; ; 1033 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1034 7 RETURN KER_NORMAL; ; 1035 6 END; ; 1036 6 ; 1037 6 [OTHERWISE, %B'11'] : ; 1038 6 RETURN KER_ILLFILTYP; ; 1039 6 TES; ; 1040 6 ; 1041 5 END; ; 1042 5 ; 1043 4 END; ; 1044 4 TES; ! End SELECTONE .RAT ; 1045 4 ; 1046 3 END; ; 1047 3 ; 1048 3 [F_STATE_POST1] : ; 1049 3 ; 1050 3 IF .RAT EQL FAB$M_PRN ; 1051 3 THEN ; 1052 4 BEGIN ; 1053 4 .CHARACTER = CHR_LFD; ; 1054 4 CC_COUNT = .CC_COUNT - 1; ; 1055 4 ; 1056 4 IF .CC_COUNT LEQ -1 ; 1057 4 THEN ; 1058 5 BEGIN ; 1059 5 .CHARACTER = CHR_CRT; ; 1060 5 ! FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 1061 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1062 4 END; ; 1063 4 ; 1064 4 RETURN KER_NORMAL; ; 1065 4 END ; 1066 3 ELSE ; 1067 3 ! ; 1068 3 ! Generate line feed after CR for funny files ; 1069 3 ! ; 1070 3 ; 1071 4 IF (.RAT EQL FAB$M_CR) ; 1072 3 THEN ; 1073 4 BEGIN ; 1074 4 .CHARACTER = CHR_LFD; ! Return a line feed ; 1075 4 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1076 4 ! Next we get data ; 1077 4 RETURN KER_NORMAL; ; 1078 4 END ; 1079 3 ELSE ; 1080 3 RETURN KER_ILLFILTYP; ; 1081 3 ; 1082 3 TES; ! End of CASE .STATE ; 1083 3 ; 1084 3 [OTHERWISE] : ; 1085 4 BEGIN ; 1086 4 ; 1087 4 WHILE .FILE_REC_COUNT LEQ 0 DO ; 1088 5 BEGIN ; 1089 5 STATUS = GET_BUFFER (); ; 1090 5 ; 1091 5 IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS; ; 1092 5 ; 1093 4 END; ; 1094 4 ; 1095 4 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 1096 4 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 1097 4 RETURN KER_NORMAL; ; 1098 3 END; ; 1099 3 TES; ! End of SELECTONE .RAT ; 1100 3 ; 1101 2 END; ! End WHILE TRUE DO loop ; 1102 2 ; 1103 2 RETURN KER_ILLFILTYP; ! Shouldn't get here ; 1104 1 END; ! End of GET_ASCII ;GET_ASCII U.4: .WORD ^M<R2,R3,R4,R5,R6> ;Save R2,R3,R4,R5,R6 0610 007C 00000 MOVL #KER_EOF, R6 ;#KER_EOF, R6 56 00000000G 8F D0 00002 MOVAB G^U.3, R5 ;U.3, R5 55 00000000V 00 9E 00009 MOVAB G^U.30, R4 ;U.30, R4 54 00000000' 00 9E 00010 MOVZBL -806(R4), R2 ;FILE_FAB+30, RAT 0859 52 FCDA C4 9A 00017 BICL2 #8, R2 ;#8, RAT 52 08 CA 0001C CMPL -844(R4), #160 ;DEV_CLASS, #160 0861 000000A0 8F FCB4 C4 D1 0001F BNEQ 1$ ;1$ 03 12 00028 MOVL #2, R2 ;#2, RAT 52 02 D0 0002A 1$: CMPL R2, #1 ;RAT, #1 0869 01 52 D1 0002D BNEQ 2$ ;2$ 09 12 00030 PUSHL 4(AP) ;CHARACTER 0871 04 AC DD 00032 CALLS #1, W^U.32 ;#1, U.32 FED0 CF 01 FB 00035 RET ; 04 0003A 2$: CMPL R2, #2 ;RAT, #2 0874 02 52 D1 0003B BEQL 3$ ;3$ 08 13 0003E CMPL R2, #4 ;RAT, #4 04 52 D1 00040 BEQL 3$ ;3$ 03 13 00043 BRW 31$ ;31$ 0128 31 00045 3$: CASEL -812(R4), #0, #4 ;FILE_FAB+24, #0, #4 0876 00 FCD4 C4 CF 00048 ; 04 0004D 4$: .WORD 5$-4$,- ;5$-4$,- 0075 000A 0004E 12$-4$,- ;12$-4$,- 00A8 0088 00052 15$-4$,- ;15$-4$,- 0101 00056 18$-4$,- ;18$-4$,- 27$-4$ ;27$-4$ 5$: CALLS #0, (R5) ;#0, GET_BUFFER 0881 65 00 FB 00058 MOVL R0, R3 ;R0, STATUS 53 50 D0 0005B BLBS R3, 7$ ;STATUS, 7$ 0883 03 53 E8 0005E 6$: BRW 32$ ;32$ 0120 31 00061 7$: CMPL R3, R6 ;STATUS, R6 56 53 D1 00064 BEQL 6$ ;6$ F8 13 00067 CMPL R2, #2 ;RAT, #2 0888 02 52 D1 00069 BEQL 8$ ;8$ 2A 13 0006C CMPL R2, #4 ;RAT, #4 0893 04 52 D1 0006E BNEQ 1$ ;1$ BA 12 00071 MOVL -616(R4), R0 ;FILE_RAB+44, TEMP_POINTER 0899 50 FD98 C4 D0 00073 MOVZBL (R0)+, (R4) ;(TEMP_POINTER)+, CC_COUNT 0900 64 80 9A 00078 MOVZBL (R0)+, 4(R4) ;(TEMP_POINTER)+, CC_TYPE 0901 04 A4 80 9A 0007B TSTB (R4) ;CC_COUNT 0903 64 95 0007F BLSS 10$ ;10$ 1C 19 00081 BITB (R4), #127 ;CC_COUNT, #127 0907 7F 8F 64 93 00083 BEQL 8$ ;8$ 0F 13 00087 MOVL #10, @4(AP) ;#10, @CHARACTER 0910 04 BC 0A D0 00089 DECL (R4) ;CC_COUNT 0911 64 D7 0008D BLEQ 14$ ;14$ 0913 3E 15 0008F MOVL #1, -812(R4) ;#1, FILE_FAB+24 0915 FCD4 C4 01 D0 00091 BRB 17$ ;17$ 5C 11 00096 8$: MOVL #2, -812(R4) ;#2, FILE_FAB+24 0922 FCD4 C4 02 D0 00098 9$: BRB 1$ ;1$ 8E 11 0009D 10$: EXTZV #5, #2, (R4), R0 ;#5, #2, CC_COUNT, R0 0928 02 05 EF 0009F ; 50 64 000A2 BNEQ 11$ ;11$ 0931 08 12 000A4 EXTZV #0, #5, (R4), @4(AP) ;#0, #5, CC_COUNT, @CHARACTER 0933 05 00 EF 000A6 ; 04 BC 64 000A9 BRB 14$ ;14$ 0934 21 11 000AC 11$: CMPL R0, #2 ;R0, #2 0938 02 50 D1 000AE BNEQ 13$ ;13$ 13 12 000B1 EXTZV #0, #5, (R4), @4(AP) ;#0, #5, CC_COUNT, @CHARACTER 0940 05 00 EF 000B3 ; 04 BC 64 000B6 ADDL2 #128, @4(AP) ;#128, @CHARACTER 04 BC 00000080 8F C0 000B9 BRB 14$ ;14$ 0941 0C 11 000C1 12$: CMPL R2, #4 ;RAT, #4 0956 04 52 D1 000C3 13$: BNEQ 26$ ;26$ 74 12 000C6 MOVL #10, @4(AP) ;#10, @CHARACTER 0959 04 BC 0A D0 000C8 SOBGTR (R4), 21$ ;CC_COUNT, 21$ 0960 50 64 F5 000CC 14$: MOVL #2, -812(R4) ;#2, FILE_FAB+24 0962 FCD4 C4 02 D0 000CF BRB 21$ ;21$ 0964 49 11 000D4 15$: TSTL -540(R4) ;FILE_REC_COUNT 0972 FDE4 C4 D5 000D6 BGTR 16$ ;16$ 07 14 000DA MOVL #3, -812(R4) ;#3, FILE_FAB+24 0974 FCD4 C4 03 D0 000DC BRB 23$ ;23$ 42 11 000E1 16$: MOVL -544(R4), R0 ;FILE_REC_POINTER, R0 0977 50 FDE0 C4 D0 000E3 MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 000E8 INCL -544(R4) ;FILE_REC_POINTER FDE0 C4 D6 000EC DECL -540(R4) ;FILE_REC_COUNT 0978 FDE4 C4 D7 000F0 17$: BRB 30$ ;30$ 0979 78 11 000F4 18$: CMPL R2, #2 ;RAT, #2 0990 02 52 D1 000F6 BNEQ 19$ ;19$ 06 12 000F9 MOVL #13, @4(AP) ;#13, @CHARACTER 0992 04 BC 0D D0 000FB BRB 20$ ;20$ 0993 19 11 000FF 19$: CMPL R2, #4 ;RAT, #4 0999 04 52 D1 00101 BNEQ 9$ ;9$ 97 12 00104 TSTB 4(R4) ;CC_TYPE 1002 04 A4 95 00106 BLSS 24$ ;24$ 1D 19 00109 BITB 4(R4), #127 ;CC_TYPE, #127 1006 7F 8F 04 A4 93 0010B BEQL 22$ ;22$ 0F 13 00110 MOVL #10, @4(AP) ;#10, @CHARACTER 1009 04 BC 0A D0 00112 MOVL 4(R4), (R4) ;CC_TYPE, CC_COUNT 1010 64 04 A4 D0 00116 20$: MOVL #4, -812(R4) ;#4, FILE_FAB+24 1011 FCD4 C4 04 D0 0011A 21$: BRB 34$ ;34$ 1012 78 11 0011F 22$: CLRL -812(R4) ;FILE_FAB+24 1015 FCD4 C4 D4 00121 23$: BRW 1$ ;1$ FF05 31 00125 24$: EXTZV #5, #2, 4(R4), R0 ;#5, #2, CC_TYPE, R0 1020 02 05 EF 00128 ; 50 04 A4 0012B BNEQ 25$ ;25$ 1023 09 12 0012E EXTZV #0, #5, 4(R4), @4(AP) ;#0, #5, CC_TYPE, @CHARACTER 1025 05 00 EF 00130 ; 04 BC 04 A4 00133 BRB 29$ ;29$ 1026 31 11 00137 25$: CMPL R0, #2 ;R0, #2 1030 02 50 D1 00139 26$: BNEQ 35$ ;35$ 63 12 0013C EXTZV #0, #5, 4(R4), @4(AP) ;#0, #5, CC_TYPE, @CHARACTER 1032 05 00 EF 0013E ; 04 BC 04 A4 00141 ADDL2 #128, @4(AP) ;#128, @CHARACTER 04 BC 00000080 8F C0 00145 BRB 29$ ;29$ 1033 1B 11 0014D 27$: CMPL R2, #4 ;RAT, #4 1050 04 52 D1 0014F BNEQ 28$ ;28$ 0D 12 00152 MOVL #10, @4(AP) ;#10, @CHARACTER 1053 04 BC 0A D0 00154 SOBGEQ (R4), 34$ ;CC_COUNT, 34$ 1054 3E 64 F4 00158 MOVL #13, @4(AP) ;#13, @CHARACTER 1059 04 BC 0D D0 0015B BRB 29$ ;29$ 1061 09 11 0015F 28$: CMPL R2, #2 ;RAT, #2 1071 02 52 D1 00161 BNEQ 35$ ;35$ 3B 12 00164 MOVL #10, @4(AP) ;#10, @CHARACTER 1074 04 BC 0A D0 00166 29$: CLRL -812(R4) ;FILE_FAB+24 1075 FCD4 C4 D4 0016A 30$: BRB 34$ ;34$ 1077 29 11 0016E 31$: TSTL -540(R4) ;FILE_REC_COUNT 1087 FDE4 C4 D5 00170 BGTR 33$ ;33$ 12 14 00174 CALLS #0, (R5) ;#0, GET_BUFFER 1089 65 00 FB 00176 MOVL R0, R3 ;R0, STATUS 53 50 D0 00179 BLBC R3, 32$ ;STATUS, 32$ 1091 05 53 E9 0017C CMPL R3, R6 ;STATUS, R6 56 53 D1 0017F BNEQ 31$ ;31$ EC 12 00182 32$: MOVL R3, R0 ;STATUS, R0 50 53 D0 00184 RET ; 04 00187 33$: DECL -540(R4) ;FILE_REC_COUNT 1095 FDE4 C4 D7 00188 MOVL -544(R4), R0 ;FILE_REC_POINTER, R0 1096 50 FDE0 C4 D0 0018C MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 00191 INCL -544(R4) ;FILE_REC_POINTER FDE0 C4 D6 00195 34$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1097 50 00000000G 8F D0 00199 RET ; 04 001A0 35$: MOVL #KER_ILLFILTYP, R0 ;#KER_ILLFILTYP, R0 1103 50 00000000G 8F D0 001A1 RET ; 04 001A8 ; Routine Size: 425 bytes, Routine Base: $CODE$ + 0161 ; 1105 1 %SBTTL 'GET_BLOCK - Get a character from a BLOCKed file' ; 1106 1 ROUTINE GET_BLOCK (CHARACTER) = ; 1107 1 ; 1108 1 !++ ; 1109 1 ! FUNCTIONAL DESCRIPTION: ; 1110 1 ! ; 1111 1 ! This routine will return the next byte from a blocked file. This ; 1112 1 ! routine will use the $READ RMS call to get the next byte from the ; 1113 1 ! file. This way all RMS header information can be passed to the ; 1114 1 ! other file system. ; 1115 1 ! ; 1116 1 ! CALLING SEQUENCE: ; 1117 1 ! ; 1118 1 ! STATUS = GET_BLOCK(CHARACTER); ; 1119 1 ! ; 1120 1 ! INPUT PARAMETERS: ; 1121 1 ! ; 1122 1 ! CHARACTER - Address to store the character in. ; 1123 1 ! ; 1124 1 ! IMPLICIT INPUTS: ; 1125 1 ! ; 1126 1 ! REC_POINTER - Pointer into the record. ; 1127 1 ! REC_ADDRESS - Address of the record. ; 1128 1 ! REC_COUNT - Count of the number of bytes left in the record. ; 1129 1 ! ; 1130 1 ! OUPTUT PARAMETERS: ; 1131 1 ! ; 1132 1 ! None. ; 1133 1 ! ; 1134 1 ! IMPLICIT OUTPUTS: ; 1135 1 ! ; 1136 1 ! None. ; 1137 1 ! ; 1138 1 ! COMPLETION CODES: ; 1139 1 ! ; 1140 1 ! KER_NORMAL - Got a byte ; 1141 1 ! KER_EOF - End of file gotten. ; 1142 1 ! KER_RMS32 - RMS error ; 1143 1 ! ; 1144 1 ! SIDE EFFECTS: ; 1145 1 ! ; 1146 1 ! None. ; 1147 1 ! ; 1148 1 !-- ; 1149 1 ; 1150 2 BEGIN ; 1151 2 ! ; 1152 2 ! Status codes returned by this module ; 1153 2 ! ; 1154 2 EXTERNAL LITERAL ; 1155 2 KER_RMS32, ! RMS error encountered ; 1156 2 KER_EOF, ! End of file encountered ; 1157 2 KER_NORMAL; ! Normal return ; 1158 2 ; 1159 2 LOCAL ; 1160 2 STATUS; ! Random status values ; 1161 2 ; 1162 2 WHILE .FILE_REC_COUNT LEQ 0 DO ; 1163 3 BEGIN ; 1164 3 STATUS = $READ (RAB = FILE_RAB); ; 1165 3 ; 1166 3 IF NOT .STATUS ; 1167 3 THEN ; 1168 3 ; 1169 3 IF .STATUS EQL RMS$_EOF ; 1170 3 THEN ; 1171 4 BEGIN ; 1172 4 EOF_FLAG = TRUE; ; 1173 4 RETURN KER_EOF; ; 1174 4 END ; 1175 3 ELSE ; 1176 4 BEGIN ; 1177 4 FILE_ERROR (.STATUS); ; 1178 4 EOF_FLAG = TRUE; ; 1179 4 RETURN KER_RMS32; ; 1180 3 END; ; 1181 3 ; 1182 3 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1183 3 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; ; 1184 2 END; ; 1185 2 ; 1186 2 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 1187 2 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 1188 2 RETURN KER_NORMAL; ; 1189 1 END; ! End of GET_BLOCK .EXTRN KER_RMS32, SYS$READ ;GET_BLOCK U.5: .WORD ^M<R2,R3> ;Save R2,R3 1106 000C 00000 MOVAB G^U.16, R3 ;U.16, R3 53 00000000' 00 9E 00002 1$: TSTL (R3) ;FILE_REC_COUNT 1162 63 D5 00009 BGTR 5$ ;5$ 43 14 0000B PUSHAB -120(R3) ;FILE_RAB 1164 88 A3 9F 0000D CALLS #1, G^SYS$READ ;#1, SYS$READ 00000000G 00 01 FB 00010 MOVL R0, R2 ;R0, STATUS 52 50 D0 00017 BLBS R2, 4$ ;STATUS, 4$ 1166 28 52 E8 0001A CMPL R2, #98938 ;STATUS, #98938 1169 0001827A 8F 52 D1 0001D BNEQ 2$ ;2$ 09 12 00024 MOVL #KER_EOF, R0 ;#KER_EOF, R0 1173 50 00000000G 8F D0 00026 BRB 3$ ;3$ 10 11 0002D 2$: PUSHL R2 ;STATUS 1177 52 DD 0002F CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00031 MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1179 50 00000000G 8F D0 00038 3$: MOVL #1, -300(R3) ;#1, EOF_FLAG 1172 FED4 C3 01 D0 0003F RET ; 1179 04 00044 4$: MOVL 8(R3), -4(R3) ;REC_ADDRESS, FILE_REC_POINTER 1182 FC A3 08 A3 D0 00045 MOVZWL -86(R3), (R3) ;FILE_RAB+34, FILE_REC_COUNT 1183 63 AA A3 3C 0004A BRB 1$ ;1$ B9 11 0004E 5$: DECL (R3) ;FILE_REC_COUNT 1186 63 D7 00050 MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 1187 50 FC A3 D0 00052 MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 00056 INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 0005A MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1188 50 00000000G 8F D0 0005D RET ; 04 00064 ; Routine Size: 101 bytes, Routine Base: $CODE$ + 030A ; 1190 1 %SBTTL 'GET_BUFFER - Routine to read a buffer.' ; 1191 1 ROUTINE GET_BUFFER = ; 1192 1 ; 1193 1 !++ ; 1194 1 ! FUNCTIONAL DESCRIPTION: ; 1195 1 ! ; 1196 1 ! This routine will read a buffer from the disk file. It will ; 1197 1 ! return various status depending if there was an error reading ; 1198 1 ! the disk file or if the end of file is reached. ; 1199 1 ! ; 1200 1 ! CALLING SEQUENCE: ; 1201 1 ! ; 1202 1 ! STATUS = GET_BUFFER (); ; 1203 1 ! ; 1204 1 ! INPUT PARAMETERS: ; 1205 1 ! ; 1206 1 ! None. ; 1207 1 ! ; 1208 1 ! IMPLICIT INPUTS: ; 1209 1 ! ; 1210 1 ! None. ; 1211 1 ! ; 1212 1 ! OUTPUT PARAMETERS: ; 1213 1 ! ; 1214 1 ! None. ; 1215 1 ! ; 1216 1 ! IMPLICIT OUTPUTS: ; 1217 1 ! ; 1218 1 ! FILE_REC_POINTER - Pointer into the record. ; 1219 1 ! FILE_REC_COUNT - Count of the number of bytes in the record. ; 1220 1 ! ; 1221 1 ! COMPLETION CODES: ; 1222 1 ! ; 1223 1 ! KER_NORMAL - Got a buffer ; 1224 1 ! KER_EOF - End of file reached. ; 1225 1 ! KER_RMS32 - RMS error ; 1226 1 ! ; 1227 1 ! SIDE EFFECTS: ; 1228 1 ! ; 1229 1 ! None. ; 1230 1 ! ; 1231 1 !-- ; 1232 1 ; 1233 2 BEGIN ; 1234 2 ! ; 1235 2 ! The following are the various status values returned by this routien ; 1236 2 ! ; 1237 2 EXTERNAL LITERAL ; 1238 2 KER_NORMAL, ! Normal return ; 1239 2 KER_EOF, ! End of file ; 1240 2 KER_RMS32; ! RMS error encountered ; 1241 2 ; 1242 2 LOCAL ; 1243 2 STATUS; ! Random status values ; 1244 2 ; 1245 2 STATUS = $GET (RAB = FILE_RAB); ; 1246 2 ; 1247 2 IF NOT .STATUS ; 1248 2 THEN ; 1249 2 ; 1250 2 IF .STATUS EQL RMS$_EOF ; 1251 2 THEN ; 1252 3 BEGIN ; 1253 3 EOF_FLAG = TRUE; ; 1254 3 RETURN KER_EOF; ; 1255 3 END ; 1256 2 ELSE ; 1257 3 BEGIN ; 1258 3 FILE_ERROR (.STATUS); ; 1259 3 EOF_FLAG = TRUE; ; 1260 3 RETURN KER_RMS32; ; 1261 2 END; ; 1262 2 ; 1263 2 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1264 2 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; ; 1265 2 RETURN KER_NORMAL; ; 1266 1 END; .EXTRN SYS$GET ;GET_BUFFER U.3: .WORD ^M<R2> ;Save R2 1191 0004 00000 MOVAB G^U.12, R2 ;U.12, R2 52 00000000' 00 9E 00002 PUSHL R2 ;R2 1245 52 DD 00009 CALLS #1, G^SYS$GET ;#1, SYS$GET 00000000G 00 01 FB 0000B BLBS R0, 3$ ;STATUS, 3$ 1247 28 50 E8 00012 CMPL R0, #98938 ;STATUS, #98938 1250 0001827A 8F 50 D1 00015 BNEQ 1$ ;1$ 09 12 0001C MOVL #KER_EOF, R0 ;#KER_EOF, R0 1254 50 00000000G 8F D0 0001E BRB 2$ ;2$ 10 11 00025 1$: PUSHL R0 ;STATUS 1258 50 DD 00027 CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00029 MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1260 50 00000000G 8F D0 00030 2$: MOVL #1, -180(R2) ;#1, EOF_FLAG 1253 FF4C C2 01 D0 00037 RET ; 1260 04 0003C 3$: MOVL 128(R2), 116(R2) ;REC_ADDRESS, FILE_REC_POINTER 1263 74 A2 0080 C2 D0 0003D MOVZWL 34(R2), 120(R2) ;FILE_RAB+34, FILE_REC_COUNT 1264 78 A2 22 A2 3C 00043 MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1265 50 00000000G 8F D0 00048 RET ; 04 0004F ; Routine Size: 80 bytes, Routine Base: $CODE$ + 036F ; 1267 1 %SBTTL 'PUT_FILE' ; 1268 1 ; 1269 1 GLOBAL ROUTINE PUT_FILE (CHARACTER) = ; 1270 1 ; 1271 1 !++ ; 1272 1 ! FUNCTIONAL DESCRIPTION: ; 1273 1 ! ; 1274 1 ! This routine will store a character into the record buffer ; 1275 1 ! that we are building. It will output the buffer to disk ; 1276 1 ! when the end of line characters are found. ; 1277 1 ! ; 1278 1 ! CALLING SEQUENCE: ; 1279 1 ! ; 1280 1 ! STATUS = PUT_FILE(Character); ; 1281 1 ! ; 1282 1 ! INPUT PARAMETERS: ; 1283 1 ! ; 1284 1 ! Character - Address of the character to output in the file. ; 1285 1 ! ; 1286 1 ! IMPLICIT INPUTS: ; 1287 1 ! ; 1288 1 ! None. ; 1289 1 ! ; 1290 1 ! OUTPUT PARAMETERS: ; 1291 1 ! ; 1292 1 ! Status - True if no problems writing the character ; 1293 1 ! False if there were problems writing the character. ; 1294 1 ! ; 1295 1 ! IMPLICIT OUTPUTS: ; 1296 1 ! ; 1297 1 ! None. ; 1298 1 ! ; 1299 1 ! COMPLETION CODES: ; 1300 1 ! ; 1301 1 ! None. ; 1302 1 ! ; 1303 1 ! SIDE EFFECTS: ; 1304 1 ! ; 1305 1 ! None. ; 1306 1 ! ; 1307 1 !-- ; 1308 1 ; 1309 2 BEGIN ; 1310 2 ! ; 1311 2 ! Completion codes ; 1312 2 ! ; 1313 2 EXTERNAL LITERAL ; 1314 2 KER_REC_TOO_BIG, ! Record too big ; 1315 2 KER_NORMAL; ! Normal return ; 1316 2 ! ; 1317 2 ! Local variables ; 1318 2 ! ; 1319 2 OWN ; 1320 2 SAVED_CHARACTER : UNSIGNED BYTE; ! Character we may have to ; 1321 2 ! write later on ; 1322 2 LOCAL ; 1323 2 STATUS; ! Random status values ; 1324 2 ; 1325 2 SELECTONE .FILE_TYPE OF ; 1326 2 SET ; 1327 2 ; 1328 2 [FILE_ASC] : ; 1329 3 BEGIN ; 1330 3 ! ; 1331 3 ! If the last character was a carriage return and this is a line feed, ; 1332 3 ! we will just dump the record. Otherwise, if the last character was ; 1333 3 ! a carriage return, output both it and the current one. ; 1334 3 ! ; 1335 3 ; 1336 3 IF .FILE_FAB [FAB$L_CTX] NEQ F_STATE_DATA ; 1337 3 THEN ; 1338 4 BEGIN ; 1339 4 ; 1340 4 IF (.CHARACTER AND %O'177') EQL CHR_LFD ; 1341 4 THEN ; 1342 5 BEGIN ; 1343 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 1344 5 RETURN DUMP_BUFFER (); ; 1345 5 END ; 1346 4 ELSE ; 1347 5 BEGIN ; 1348 5 ; 1349 5 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1350 5 THEN ; 1351 6 BEGIN ; 1352 6 LIB$SIGNAL (KER_REC_TOO_BIG); ; 1353 6 RETURN KER_REC_TOO_BIG; ; 1354 5 END; ; 1355 5 ; 1356 5 CH$WCHAR_A (.SAVED_CHARACTER, FILE_REC_POINTER); ; 1357 5 ! Store the carriage return we deferred ; 1358 5 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1359 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ! Back to normal data ; 1360 4 END; ; 1361 4 ; 1362 3 END; ; 1363 3 ; 1364 3 ! ; 1365 3 ! Here when last character was written to the file normally. Check if ; 1366 3 ! this character might be the end of a record (or at least the start of ; 1367 3 ! end. ; 1368 3 ! ; 1369 3 ; 1370 3 IF (.CHARACTER AND %O'177') EQL CHR_CRT ; 1371 3 THEN ; 1372 4 BEGIN ; 1373 4 SAVED_CHARACTER = .CHARACTER; ! Save the character for later ; 1374 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST; ! Remember we saw this ; 1375 4 RETURN KER_NORMAL; ! And delay until next character ; 1376 3 END; ; 1377 3 ; 1378 3 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1379 3 THEN ; 1380 4 BEGIN ; 1381 4 LIB$SIGNAL (KER_REC_TOO_BIG); ; 1382 4 RETURN KER_REC_TOO_BIG; ; 1383 3 END; ; 1384 3 ; 1385 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1386 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1387 2 END; ; 1388 2 ; 1389 2 [FILE_BIN, FILE_FIX] : ; 1390 3 BEGIN ; 1391 3 ; 1392 3 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1393 3 THEN ; 1394 4 BEGIN ; 1395 4 STATUS = DUMP_BUFFER (); ; 1396 4 ; 1397 4 IF NOT .STATUS ; 1398 4 THEN ; 1399 5 BEGIN ; 1400 5 LIB$SIGNAL (.STATUS); ; 1401 5 RETURN .STATUS; ; 1402 4 END; ; 1403 4 ; 1404 3 END; ; 1405 3 ; 1406 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1407 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1408 2 END; ; 1409 2 ; 1410 2 [FILE_BLK] : ; 1411 3 BEGIN ; 1412 3 ; 1413 3 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1414 3 THEN ; 1415 4 BEGIN ; 1416 4 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1417 4 STATUS = $WRITE (RAB = FILE_RAB); ; 1418 4 FILE_REC_COUNT = 0; ; 1419 4 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1420 3 END; ; 1421 3 ; 1422 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1423 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1424 2 END; ; 1425 2 TES; ; 1426 2 ; 1427 2 RETURN KER_NORMAL; ; 1428 1 END; ! End of PUT_FILE .PSECT $OWN$,NOEXE,2 ;SAVED_CHARACTER U.34: .BLKB 1 ; 00358 .EXTRN KER_REC_TOO_BIG, SYS$WRITE .PSECT $CODE$,NOWRT,2 .ENTRY PUT_FILE, ^M<R2,R3,R4,R5,R6> ;PUT_FILE, Save R2,R3,R4,R5,R6 1269 007C 00000 MOVAB G^LIB$SIGNAL, R6 ;LIB$SIGNAL, R6 56 00000000G 00 9E 00002 MOVL #KER_REC_TOO_BIG, R5 ;#KER_REC_TOO_BIG, R5 55 00000000G 8F D0 00009 MOVAB G^U.2, R4 ;U.2, R4 54 00000000V 00 9E 00010 MOVAB G^U.16, R3 ;U.16, R3 53 00000000' 00 9E 00017 MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 1325 50 00000000' 00 D0 0001E CMPL R0, #1 ;R0, #1 1328 01 50 D1 00025 BNEQ 5$ ;5$ 55 12 00028 CMPL -272(R3), #2 ;FILE_FAB+24, #2 1336 02 FEF0 C3 D1 0002A BEQL 2$ ;2$ 2A 13 0002F CMPZV #0, #7, 4(AP), #10 ;#0, #7, CHARACTER, #10 1340 07 00 ED 00031 ; 0A 04 AC 00034 BNEQ 1$ ;1$ 09 12 00037 MOVL #2, -272(R3) ;#2, FILE_FAB+24 1343 FEF0 C3 02 D0 00039 CALLS #0, (R4) ;#0, DUMP_BUFFER 1344 64 00 FB 0003E RET ; 04 00041 1$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE 1349 04 A3 63 D1 00042 BGEQ 4$ ;4$ 2E 18 00046 MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 1356 50 FC A3 D0 00048 MOVB 548(R3), (R0) ;SAVED_CHARACTER, (R0) 60 0224 C3 90 0004C INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 00051 INCL (R3) ;FILE_REC_COUNT 1358 63 D6 00054 MOVL #2, -272(R3) ;#2, FILE_FAB+24 1359 FEF0 C3 02 D0 00056 2$: CMPZV #0, #7, 4(AP), #13 ;#0, #7, CHARACTER, #13 1370 07 00 ED 0005B ; 0D 04 AC 0005E BNEQ 3$ ;3$ 0D 12 00061 MOVB 4(AP), 548(R3) ;CHARACTER, SAVED_CHARACTER 1373 0224 C3 04 AC 90 00063 MOVL #3, -272(R3) ;#3, FILE_FAB+24 1374 FEF0 C3 03 D0 00069 BRB 9$ ;9$ 1375 64 11 0006E 3$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE 1378 04 A3 63 D1 00070 BLSS 8$ ;8$ 51 19 00074 4$: PUSHL R5 ;R5 1381 55 DD 00076 CALLS #1, (R6) ;#1, LIB$SIGNAL 66 01 FB 00078 MOVL R5, R0 ;R5, R0 1382 50 55 D0 0007B RET ; 04 0007E 5$: CMPL R0, #2 ;R0, #2 1389 02 50 D1 0007F BEQL 6$ ;6$ 05 13 00082 CMPL R0, #4 ;R0, #4 04 50 D1 00084 BNEQ 7$ ;7$ 18 12 00087 6$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE 1392 04 A3 63 D1 00089 BLSS 8$ ;8$ 38 19 0008D CALLS #0, (R4) ;#0, DUMP_BUFFER 1395 64 00 FB 0008F MOVL R0, R2 ;R0, STATUS 52 50 D0 00092 BLBS R2, 8$ ;STATUS, 8$ 1397 2F 52 E8 00095 PUSHL R2 ;STATUS 1400 52 DD 00098 CALLS #1, (R6) ;#1, LIB$SIGNAL 66 01 FB 0009A MOVL R2, R0 ;STATUS, R0 1401 50 52 D0 0009D RET ; 04 000A0 7$: CMPL R0, #3 ;R0, #3 1410 03 50 D1 000A1 BNEQ 9$ ;9$ 2E 12 000A4 MOVL (R3), R0 ;FILE_REC_COUNT, R0 1413 50 63 D0 000A6 CMPL R0, 4(R3) ;R0, REC_SIZE 04 A3 50 D1 000A9 BLSS 8$ ;8$ 18 19 000AD MOVW R0, -86(R3) ;R0, FILE_RAB+34 1416 AA A3 50 B0 000AF PUSHAB -120(R3) ;FILE_RAB 1417 88 A3 9F 000B3 CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE 00000000G 00 01 FB 000B6 MOVL R0, R2 ;R0, STATUS 52 50 D0 000BD CLRL (R3) ;FILE_REC_COUNT 1418 63 D4 000C0 MOVL 8(R3), -4(R3) ;REC_ADDRESS, FILE_REC_POINTER 1419 FC A3 08 A3 D0 000C2 8$: INCL (R3) ;FILE_REC_COUNT 1422 63 D6 000C7 MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 1423 50 FC A3 D0 000C9 MOVB 4(AP), (R0) ;CHARACTER, (R0) 60 04 AC 90 000CD INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 000D1 9$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1427 50 00000000G 8F D0 000D4 RET ; 04 000DB ; Routine Size: 220 bytes, Routine Base: $CODE$ + 03BF ; 1429 1 ; 1430 1 %SBTTL 'DUMP_BUFFER - Dump the current record to disk' ; 1431 1 ROUTINE DUMP_BUFFER = ; 1432 1 ; 1433 1 !++ ; 1434 1 ! FUNCTIONAL DESCRIPTION: ; 1435 1 ! ; 1436 1 ! This routine will dump the current record to disk. It doesn't ; 1437 1 ! care what type of file you are writing, unlike FILE_DUMP. ; 1438 1 ! ; 1439 1 ! CALLING SEQUENCE: ; 1440 1 ! ; 1441 1 ! STATUS = DUMP_BUFFER(); ; 1442 1 ! ; 1443 1 ! INPUT PARAMETERS: ; 1444 1 ! ; 1445 1 ! None. ; 1446 1 ! ; 1447 1 ! IMPLICIT INPUTS: ; 1448 1 ! ; 1449 1 ! None. ; 1450 1 ! ; 1451 1 ! OUTPUT PARAMETERS: ; 1452 1 ! ; 1453 1 ! None. ; 1454 1 ! ; 1455 1 ! IMPLICIT OUTPUTS: ; 1456 1 ! ; 1457 1 ! None. ; 1458 1 ! ; 1459 1 ! COMPLETION CODES: ; 1460 1 ! ; 1461 1 ! KER_NORMAL - Output went ok. ; 1462 1 ! KER_RMS32 - RMS-32 error. ; 1463 1 ! ; 1464 1 ! SIDE EFFECTS: ; 1465 1 ! ; 1466 1 ! None. ; 1467 1 ! ; 1468 1 !-- ; 1469 1 ; 1470 2 BEGIN ; 1471 2 ! ; 1472 2 ! Completion codes returned: ; 1473 2 ! ; 1474 2 EXTERNAL LITERAL ; 1475 2 KER_NORMAL, ! Normal return ; 1476 2 KER_RMS32; ! RMS-32 error ; 1477 2 ! ; 1478 2 ! Local variables ; 1479 2 ! ; 1480 2 LOCAL ; 1481 2 STATUS; ! Random status values ; 1482 2 ; 1483 2 ! ; 1484 2 ! First update the record length ; 1485 2 ! ; 1486 2 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1487 2 ! ; 1488 2 ! Now output the record to the file ; 1489 2 ! ; 1490 2 STATUS = $PUT (RAB = FILE_RAB); ; 1491 2 ! ; 1492 2 ! Update the pointers first ; 1493 2 ! ; 1494 2 FILE_REC_COUNT = 0; ; 1495 2 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1496 2 ! ; 1497 2 ! Now determine if we failed attempting to write the record ; 1498 2 ! ; 1499 2 ; 1500 2 IF NOT .STATUS ; 1501 2 THEN ; 1502 3 BEGIN ; 1503 3 FILE_ERROR (.STATUS); ; 1504 3 RETURN KER_RMS32 ; 1505 2 END; ; 1506 2 ; 1507 2 RETURN KER_NORMAL ; 1508 1 END; ! End of DUMP_BUFFER .EXTRN SYS$PUT ;DUMP_BUFFER U.2: .WORD ^M<R2> ;Save R2 1431 0004 00000 MOVAB G^U.16, R2 ;U.16, R2 52 00000000' 00 9E 00002 MOVW (R2), -86(R2) ;FILE_REC_COUNT, FILE_RAB+34 1486 AA A2 62 B0 00009 PUSHAB -120(R2) ;FILE_RAB 1490 88 A2 9F 0000D CALLS #1, G^SYS$PUT ;#1, SYS$PUT 00000000G 00 01 FB 00010 CLRL (R2) ;FILE_REC_COUNT 1494 62 D4 00017 MOVL 8(R2), -4(R2) ;REC_ADDRESS, FILE_REC_POINTER 1495 FC A2 08 A2 D0 00019 BLBS R0, 1$ ;STATUS, 1$ 1500 11 50 E8 0001E PUSHL R0 ;STATUS 1503 50 DD 00021 CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00023 MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1504 50 00000000G 8F D0 0002A RET ; 04 00031 1$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1507 50 00000000G 8F D0 00032 RET ; 04 00039 ; Routine Size: 58 bytes, Routine Base: $CODE$ + 049B ; 1509 1 %SBTTL 'OPEN_READING' ; 1510 1 ROUTINE OPEN_READING = ; 1511 1 ; 1512 1 !++ ; 1513 1 ! FUNCTIONAL DESCRIPTION: ; 1514 1 ! ; 1515 1 ! This routine will open a file for reading. It will return either ; 1516 1 ! true or false to the called depending on the success of the ; 1517 1 ! operation. ; 1518 1 ! ; 1519 1 ! CALLING SEQUENCE: ; 1520 1 ! ; 1521 1 ! status = OPEN_READING(); ; 1522 1 ! ; 1523 1 ! INPUT PARAMETERS: ; 1524 1 ! ; 1525 1 ! None. ; 1526 1 ! ; 1527 1 ! IMPLICIT INPUTS: ; 1528 1 ! ; 1529 1 ! None. ; 1530 1 ! ; 1531 1 ! OUTPUT PARAMETERS: ; 1532 1 ! ; 1533 1 ! None. ; 1534 1 ! ; 1535 1 ! IMPLICIT OUTPUTS: ; 1536 1 ! ; 1537 1 ! None. ; 1538 1 ! ; 1539 1 ! COMPLETION CODES: ; 1540 1 ! ; 1541 1 ! KER_NORMAL - Normal return ; 1542 1 ! KER_RMS32 - RMS error encountered ; 1543 1 ! ; 1544 1 ! SIDE EFFECTS: ; 1545 1 ! ; 1546 1 ! None. ; 1547 1 ! ; 1548 1 !-- ; 1549 1 ; 1550 2 BEGIN ; 1551 2 ! ; 1552 2 ! Completion codes returned: ; 1553 2 ! ; 1554 2 EXTERNAL LITERAL ; 1555 2 KER_NORMAL, ! Normal return ; 1556 2 KER_RMS32; ! RMS-32 error ; 1557 2 ; 1558 2 LOCAL ; 1559 2 STATUS; ! Random status values ; 1560 2 ; 1561 2 ! ; 1562 2 ! We now have an expanded file specification that we can use to process ; 1563 2 ! the file. ; 1564 2 ! ; 1565 2 ; 1566 2 IF .FILE_TYPE NEQ FILE_BLK ; 1567 2 THEN ; 1568 3 BEGIN ; P 1569 3 $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM, ; 1570 3 XAB = FILE_XABFHC); ; 1571 3 END ; 1572 2 ELSE ; 1573 3 BEGIN ; P 1574 3 $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM, ; 1575 3 NAM = FILE_NAM, XAB = FILE_XABFHC); ; 1576 2 END; ; 1577 2 ; 1578 2 $XABFHC_INIT (XAB = FILE_XABFHC); ; 1579 2 STATUS = $OPEN (FAB = FILE_FAB); ; 1580 2 ; 1581 3 IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF) ; 1582 2 THEN ; 1583 3 BEGIN ; 1584 3 FILE_ERROR (.STATUS); ; 1585 3 RETURN KER_RMS32; ; 1586 2 END; ; 1587 2 ; 1588 2 ! ; 1589 2 ! Now allocate a buffer for the records ; 1590 2 ! ; 1591 2 REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]); ; 1592 2 ; 1593 2 IF .REC_SIZE EQL 0 THEN REC_SIZE = MAX_REC_LENGTH; ; 1594 2 ; 1595 2 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 1596 2 ! ; 1597 2 ! Determine if we need a buffer for the fixed control area ; 1598 2 ! ; 1599 2 FIX_SIZE = .FILE_FAB [FAB$B_FSZ]; ; 1600 2 ; 1601 2 IF .FIX_SIZE NEQ 0 ; 1602 2 THEN ; 1603 3 BEGIN ; 1604 3 STATUS = LIB$GET_VM (FIX_SIZE, FIX_ADDRESS); ; 1605 2 END; ; 1606 2 ; 1607 2 ! ; 1608 2 ! Initialize the RAB for the $CONNECT RMS call ; 1609 2 ! ; P 1610 2 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .REC_ADDRESS, ; 1611 2 USZ = .REC_SIZE); ; 1612 2 ; 1613 2 IF .FIX_SIZE NEQ 0 THEN FILE_RAB [RAB$L_RHB] = .FIX_ADDRESS; ; 1614 2 ; 1615 2 ! Store header address ; 1616 2 STATUS = $CONNECT (RAB = FILE_RAB); ; 1617 2 ; 1618 2 IF NOT .STATUS ; 1619 2 THEN ; 1620 3 BEGIN ; 1621 3 FILE_ERROR (.STATUS); ; 1622 3 RETURN KER_RMS32; ; 1623 2 END; ; 1624 2 ; 1625 2 FILE_REC_COUNT = -1; ; 1626 2 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1627 2 RETURN KER_NORMAL; ; 1628 1 END; ! End of OPEN_READING U.36= U.10 U.37= U.10 U.38= U.13 U.39= U.12 .EXTRN SYS$OPEN, SYS$CONNECT ;OPEN_READING U.35: .WORD ^M<R2,R3,R4,R5,R6,R7,R8,R9> ;Save R2,R3,R4,R5,R6,R7,R8,R9 1510 03FC 00000 MOVAB G^FILE_TYPE, R9 ;FILE_TYPE, R9 59 00000000' 00 9E 00002 MOVAB G^LIB$GET_VM, R8 ;LIB$GET_VM, R8 58 00000000G 00 9E 00009 MOVAB G^U.36, R7 ;U.36, R7 57 00000000' 00 9E 00010 CMPL (R9), #3 ;FILE_TYPE, #3 1566 03 69 D1 00017 BEQL 1$ ;1$ 1B 13 0001A MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, $RMS_PTR 1570 6E 00 2C 0001C ; 0050 8F 00 0001F ; 67 00023 MOVW #20483, (R7) ;#20483, $RMS_PTR 67 5003 8F B0 00024 MOVL #16777216, 4(R7) ;#16777216, $RMS_PTR+4 04 A7 01000000 8F D0 00029 MOVB #2, 22(R7) ;#2, $RMS_PTR+22 16 A7 02 90 00031 BRB 2$ ;2$ 19 11 00035 1$: MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, $RMS_PTR 1575 6E 00 2C 00037 ; 0050 8F 00 0003A ; 67 0003E MOVW #20483, (R7) ;#20483, $RMS_PTR 67 5003 8F B0 0003F MOVL #16777216, 4(R7) ;#16777216, $RMS_PTR+4 04 A7 01000000 8F D0 00044 MOVB #34, 22(R7) ;#34, $RMS_PTR+22 16 A7 22 90 0004C 2$: MOVB #4, 31(R7) ;#4, $RMS_PTR+31 1F A7 04 90 00050 MOVAB 244(R7), 36(R7) ;FILE_XABFHC, $RMS_PTR+36 24 A7 00F4 C7 9E 00054 MOVAB 80(R7), 40(R7) ;FILE_NAM, $RMS_PTR+40 1570 28 A7 50 A7 9E 0005A MOVC5 #0, (SP), #0, #44, 244(R7) ;#0, (SP), #0, #44, $RMS_PTR 1578 6E 00 2C 0005F ; 2C 00 00062 ; 00F4 C7 00064 MOVW #11293, 244(R7) ;#11293, $RMS_PTR 00F4 C7 2C1D 8F B0 00067 PUSHL R7 ;R7 1579 57 DD 0006E CALLS #1, G^SYS$OPEN ;#1, SYS$OPEN 00000000G 00 01 FB 00070 MOVL R0, R6 ;R0, STATUS 56 50 D0 00077 CMPL R6, #65537 ;STATUS, #65537 1581 00010001 8F 56 D1 0007A BEQL 3$ ;3$ 0C 13 00081 CMPL R6, #98353 ;STATUS, #98353 00018031 8F 56 D1 00083 BEQL 3$ ;3$ 03 13 0008A BRW 9$ ;9$ 0092 31 0008C 3$: CMPL (R9), #3 ;FILE_TYPE, #3 1591 03 69 D1 0008F BNEQ 4$ ;4$ 07 12 00092 MOVZWL #512, R0 ;#512, R0 50 0200 8F 3C 00094 BRB 5$ ;5$ 05 11 00099 4$: MOVZWL 254(R7), R0 ;FILE_XABFHC+10, R0 50 00FE C7 3C 0009B 5$: MOVL R0, 300(R7) ;R0, REC_SIZE 012C C7 50 D0 000A0 BNEQ 6$ ;6$ 1593 07 12 000A5 MOVZWL #4096, 300(R7) ;#4096, REC_SIZE 012C C7 1000 8F 3C 000A7 6$: PUSHAB 304(R7) ;REC_ADDRESS 1595 0130 C7 9F 000AE PUSHAB 300(R7) ;REC_SIZE 012C C7 9F 000B2 CALLS #2, (R8) ;#2, LIB$GET_VM 68 02 FB 000B6 MOVL R0, R6 ;R0, STATUS 56 50 D0 000B9 MOVZBL 63(R7), 308(R7) ;FILE_FAB+63, FIX_SIZE 1599 0134 C7 3F A7 9A 000BC BEQL 7$ ;7$ 1601 0E 13 000C2 PUSHAB 312(R7) ;FIX_ADDRESS 1604 0138 C7 9F 000C4 PUSHAB 308(R7) ;FIX_SIZE 0134 C7 9F 000C8 CALLS #2, (R8) ;#2, LIB$GET_VM 68 02 FB 000CC MOVL R0, R6 ;R0, STATUS 56 50 D0 000CF 7$: MOVC5 #0, (SP), #0, #68, 176(R7) ;#0, (SP), #0, #68, $RMS_PTR 1611 6E 00 2C 000D2 ; 0044 8F 00 000D5 ; 00B0 C7 000D9 MOVW #17409, 176(R7) ;#17409, $RMS_PTR 00B0 C7 4401 8F B0 000DC MOVL #1048576, 180(R7) ;#1048576, $RMS_PTR+4 00B4 C7 00100000 8F D0 000E3 CLRB 206(R7) ;$RMS_PTR+30 00CE C7 94 000EC MOVW 300(R7), 208(R7) ;REC_SIZE, $RMS_PTR+32 00D0 C7 012C C7 B0 000F0 MOVL 304(R7), 212(R7) ;REC_ADDRESS, $RMS_PTR+36 00D4 C7 0130 C7 D0 000F7 MOVAB (R7), 236(R7) ;FILE_FAB, $RMS_PTR+60 00EC C7 67 9E 000FE TSTL 308(R7) ;FIX_SIZE 1613 0134 C7 D5 00103 BEQL 8$ ;8$ 07 13 00107 MOVL 312(R7), 220(R7) ;FIX_ADDRESS, FILE_RAB+44 00DC C7 0138 C7 D0 00109 8$: PUSHAB 176(R7) ;FILE_RAB 1616 00B0 C7 9F 00110 CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT 00000000G 00 01 FB 00114 MOVL R0, R6 ;R0, STATUS 56 50 D0 0011B BLBS R6, 10$ ;STATUS, 10$ 1618 11 56 E8 0011E 9$: PUSHL R6 ;STATUS 1621 56 DD 00121 CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00123 MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1622 50 00000000G 8F D0 0012A RET ; 04 00131 10$: MNEGL #1, 296(R7) ;#1, FILE_REC_COUNT 1625 0128 C7 01 CE 00132 CLRL 24(R7) ;FILE_FAB+24 1626 18 A7 D4 00137 MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1627 50 00000000G 8F D0 0013A RET ; 04 00141 ; Routine Size: 322 bytes, Routine Base: $CODE$ + 04D5 ; 1629 1 %SBTTL 'FILE_OPEN' ; 1630 1 ; 1631 1 GLOBAL ROUTINE FILE_OPEN (FUNCTION) = ; 1632 1 ; 1633 1 !++ ; 1634 1 ! FUNCTIONAL DESCRIPTION: ; 1635 1 ! ; 1636 1 ! This routine will open a file for reading or writing depending on ; 1637 1 ! the function that is passed this routine. It will handle wildcards ; 1638 1 ! on the read function. ; 1639 1 ! ; 1640 1 ! CALLING SEQUENCE: ; 1641 1 ! ; 1642 1 ! status = FILE_OPEN(FUNCTION); ; 1643 1 ! ; 1644 1 ! INPUT PARAMETERS: ; 1645 1 ! ; 1646 1 ! FUNCTION - Function to do. Either FNC_READ or FNC_WRITE. ; 1647 1 ! ; 1648 1 ! IMPLICIT INPUTS: ; 1649 1 ! ; 1650 1 ! FILE_NAME and FILE_SIZE set up with the file name and the length ; 1651 1 ! of the name. ; 1652 1 ! ; 1653 1 ! OUTPUT PARAMETERS: ; 1654 1 ! ; 1655 1 ! None. ; 1656 1 ! ; 1657 1 ! IMPLICIT OUTPUTS: ; 1658 1 ! ; 1659 1 ! FILE_NAME and FILE_SIZE set up with the file name and the length ; 1660 1 ! of the name. ; 1661 1 ! ; 1662 1 ! COMPLETION CODES: ; 1663 1 ! ; 1664 1 ! KER_NORMAL - File opened correctly. ; 1665 1 ! KER_RMS32 - Problem processing the file. ; 1666 1 ! KER_INTERNALERR - Internal Kermit-32 error. ; 1667 1 ! ; 1668 1 ! SIDE EFFECTS: ; 1669 1 ! ; 1670 1 ! None. ; 1671 1 ! ; 1672 1 !-- ; 1673 1 ; 1674 2 BEGIN ; 1675 2 ! ; 1676 2 ! Completion codes returned: ; 1677 2 ! ; 1678 2 EXTERNAL LITERAL ; 1679 2 KER_NORMAL, ! Normal return ; 1680 2 KER_INTERNALERR, ! Internal error ; 1681 2 KER_RMS32; ! RMS-32 error ; 1682 2 ; 1683 2 EXTERNAL ROUTINE ; 1684 2 TT_TEXT : NOVALUE; ! Output an ASCIZ string ; 1685 2 ; 1686 2 EXTERNAL ROUTINE ; 1687 2 ! ; 1688 2 ! This external routine is called to perform any checks on the file ; 1689 2 ! specification that the user wishes. It must return a true value ; 1690 2 ! if the access is to be allowed, and a false value (error code) if ; 1691 2 ! access is to be denied. The error code may be any valid system wide ; 1692 2 ! error code, any Kermit-32 error code (KER_xxx) or a user specific code, ; 1693 2 ! provided a message file defining the error code is loaded with Kermit-32. ; 1694 2 ! ; 1695 2 ! The routine is called as: ; 1696 2 ! ; 1697 2 ! STATUS = USER_FILE_CHECK ( FILE NAME DESCRIPTOR, READ/WRITE FLAG) ; 1698 2 ! ; 1699 2 ! The file name descriptor points to the file specification supplied by ; 1700 2 ! the user. The read/write flag is TRUE if the file is being read, and ; 1701 2 ! false if it is being written. ; 1702 2 ! ; 1703 2 USER_FILE_CHECK : ADDRESSING_MODE(GENERAL) WEAK; ; 1704 2 ; 1705 2 LOCAL ; 1706 2 STATUS, ! Random status values ; 1707 2 ITMLST : VECTOR [4, LONG], ! For GETDVI call ; 1708 2 SIZE : WORD; ! Size of resulting file name ; 1709 2 ; 1710 2 ! ; 1711 2 ! Assume we can do searches ; 1712 2 ! ; 1713 2 SEARCH_FLAG = TRUE; ; 1714 2 DEV_CLASS = DC$_DISK; ! Assume disk file ; 1715 2 ! ; 1716 2 ! Now do the function dependent processing ; 1717 2 ! ; 1718 2 FILE_MODE = .FUNCTION; ; 1719 2 FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE; ! Length of file name ; 1720 2 ! ; 1721 2 ! Call user routine (if any) ; 1722 2 ! ; 1723 2 IF USER_FILE_CHECK NEQ 0 ; 1724 2 THEN ; 1725 3 BEGIN ; 1726 3 STATUS = USER_FILE_CHECK (FILE_DESC, %REF (.FILE_MODE EQL FNC_READ)); ; 1727 3 IF NOT .STATUS ; 1728 3 THEN ; 1729 4 BEGIN ; 1730 4 LIB$SIGNAL (.STATUS); ; 1731 4 RETURN .STATUS; ; 1732 3 END; ; 1733 2 END; ; 1734 2 ! ; 1735 2 ! Select the correct routine depending on if we are reading or writing. ; 1736 2 ! ; 1737 2 ; 1738 2 SELECTONE .FUNCTION OF ; 1739 2 SET ; 1740 2 ; 1741 2 [FNC_READ] : ; 1742 3 BEGIN ; 1743 3 ! ; 1744 3 ! Determine device type ; 1745 3 ! ; 1746 3 ITMLST [0] = DVI$_DEVCLASS^16 + 4; ! Want device class ; 1747 3 ITMLST [1] = DEV_CLASS; ! Put it there ; 1748 3 ITMLST [2] = ITMLST [2]; ! Put the size here ; 1749 3 ITMLST [3] = 0; ! End the list ; 1750 3 STATUS = $GETDVIW (DEVNAM = FILE_DESC, ITMLST = ITMLST); ; 1751 3 ! ; 1752 3 ! If not a disk, can't do search ; 1753 3 ! ; 1754 3 IF .STATUS AND .DEV_CLASS NEQ DC$_DISK THEN SEARCH_FLAG = FALSE; ; 1755 3 ; 1756 3 ! ; 1757 3 ! Now set up the FAB with the information it needs. ; 1758 3 ! ; P 1759 3 $FAB_INIT (FAB = FILE_FAB, FOP = NAM, FNA = FILE_NAME, FNS = .FILE_SIZE, ; 1760 3 NAM = FILE_NAM, DNM = '.;0'); ; 1761 3 ! ; 1762 3 ! Now initialize the NAM block ; 1763 3 ! ; P 1764 3 $NAM_INIT (NAM = FILE_NAM, RSA = RES_STR, RSS = NAM$C_MAXRSS, ESA = EXP_STR, ; 1765 3 ESS = NAM$C_MAXRSS); ; 1766 3 ! ; 1767 3 ! First parse the file specification. ; 1768 3 ! ; 1769 3 STATUS = $PARSE (FAB = FILE_FAB); ; 1770 3 ; 1771 3 IF NOT .STATUS ; 1772 3 THEN ; 1773 4 BEGIN ; 1774 4 FILE_ERROR (.STATUS); ; 1775 4 RETURN KER_RMS32; ; 1776 3 END; ; 1777 3 ; 1778 3 IF .SEARCH_FLAG ; 1779 3 THEN ; 1780 4 BEGIN ; 1781 4 STATUS = $SEARCH (FAB = FILE_FAB); ; 1782 4 ; 1783 4 IF NOT .STATUS ; 1784 4 THEN ; 1785 5 BEGIN ; 1786 5 FILE_ERROR (.STATUS); ; 1787 5 RETURN KER_RMS32; ; 1788 4 END; ; 1789 4 ; 1790 3 END; ; 1791 3 ; 1792 3 ! ; 1793 3 ! We now have an expanded file specification that we can use to process ; 1794 3 ! the file. ; 1795 3 ! ; 1796 3 STATUS = OPEN_READING (); ! Open the file ; 1797 3 ; 1798 3 IF NOT .STATUS THEN RETURN .STATUS; ! If we couldn't, pass error back ; 1799 3 ; 1800 3 ! ; 1801 3 ! Tell user what name we ended up with for storing the file ; 1802 3 ! ; 1803 3 ; 1804 3 IF ( NOT .CONNECT_FLAG) AND .TY_FIL ; 1805 3 THEN ; 1806 4 BEGIN ; 1807 4 ; 1808 4 IF .FILE_NAM [NAM$B_RSS] GTR 0 ; 1809 4 THEN ; 1810 5 BEGIN ; 1811 5 CH$WCHAR (CHR_NUL, ; 1812 5 CH$PTR (.FILE_NAM [NAM$L_RSA], ; 1813 5 .FILE_NAM [NAM$B_RSL])); ; 1814 5 TT_TEXT (.FILE_NAM [NAM$L_RSA]); ; 1815 5 END ; 1816 4 ELSE ; 1817 5 BEGIN ; 1818 5 CH$WCHAR (CHR_NUL, ; 1819 5 CH$PTR (.FILE_NAM [NAM$L_ESA], ; 1820 5 .FILE_NAM [NAM$B_ESL])); ; 1821 5 TT_TEXT (.FILE_NAM [NAM$L_ESA]); ; 1822 4 END; ; 1823 4 ; 1824 4 TT_TEXT (UPLIT (%ASCIZ' as ')); ; 1825 3 END; ; 1826 3 ; 1827 2 END; ! End of [FNC_READ] ; 1828 2 ; 1829 2 [FNC_WRITE] : ; 1830 3 BEGIN ; 1831 3 ; 1832 3 SELECTONE .FILE_TYPE OF ; 1833 3 SET ; 1834 3 ; 1835 3 [FILE_ASC] : ; 1836 4 BEGIN ; P 1837 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1838 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; 1839 4 ORG = SEQ, RFM = VAR, RAT = CR); ; 1840 3 END; ; 1841 3 ; 1842 3 [FILE_BIN] : ; 1843 4 BEGIN ; P 1844 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1845 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; 1846 4 ORG = SEQ, RFM = VAR); ; 1847 3 END; ; 1848 3 ; 1849 3 [FILE_FIX] : ; 1850 4 BEGIN ; P 1851 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1852 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; P 1853 4 ORG = SEQ, RFM = FIX, MRS = (IF .file_blocksize_set ; P 1854 4 THEN .file_blocksize ; 1855 4 ELSE 512)); ; 1856 3 END; ; 1857 3 ; 1858 3 [FILE_BLK] : ; 1859 4 BEGIN ; P 1860 4 $FAB_INIT (FAB = FILE_FAB, FAC = (PUT, BIO), FNA = FILE_NAME, ; 1861 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM); ; 1862 3 END; ; 1863 3 TES; ; 1864 3 ; 1865 3 ! ; 1866 3 ! If we had an alternate file name from the receive command, use it ; 1867 3 ! instead of what KERMSG has told us. ; 1868 3 ! ; 1869 3 ; 1870 3 IF .ALT_FILE_SIZE GTR 0 ; 1871 3 THEN ; 1872 4 BEGIN ; 1873 4 LOCAL ; 1874 4 ALT_FILE_DESC : BLOCK [8, BYTE]; ; 1875 4 ; 1876 4 ALT_FILE_DESC = .FILE_DESC; ; 1877 4 ALT_FILE_DESC [DSC$W_LENGTH] = .ALT_FILE_SIZE; ; 1878 4 ALT_FILE_DESC [DSC$A_POINTER] = ALT_FILE_NAME; ; 1879 4 IF USER_FILE_CHECK NEQ 0 ; 1880 4 THEN ; 1881 5 BEGIN ; 1882 5 STATUS = USER_FILE_CHECK (ALT_FILE_DESC, %REF (.FILE_MODE EQL FNC_READ)); ; 1883 5 IF NOT .STATUS ; 1884 5 THEN ; 1885 6 BEGIN ; 1886 6 LIB$SIGNAL (.STATUS); ; 1887 6 RETURN .STATUS; ; 1888 5 END; ; 1889 4 END; ; 1890 4 FILE_FAB [FAB$L_FNA] = ALT_FILE_NAME; ; 1891 4 FILE_FAB [FAB$B_FNS] = .ALT_FILE_SIZE; ; 1892 3 END; ; 1893 3 ; P 1894 3 $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR, ; 1895 3 RSS = NAM$C_MAXRSS); ; 1896 3 ! ; 1897 3 ! Now allocate a buffer for the records ; 1898 3 ! ; 1899 3 ! Determine correct buffer size ; 1900 3 ; 1901 3 SELECTONE .FILE_TYPE OF ; 1902 3 SET ; 1903 3 ; 1904 3 [FILE_ASC] : ; 1905 3 REC_SIZE = MAX_REC_LENGTH; ; 1906 3 ; 1907 3 [FILE_BIN] : ; 1908 4 REC_SIZE = (IF .file_blocksize_set THEN .file_blocksize ; 1909 3 ELSE 510); ; 1910 3 ; 1911 3 [FILE_BLK] : ; 1912 3 REC_SIZE = 512; ; 1913 3 ; 1914 3 [FILE_FIX] : ; 1915 4 REC_SIZE = (IF .file_blocksize_set THEN .file_blocksize ; 1916 3 ELSE 512); ; 1917 3 ; 1918 3 TES; ; 1919 3 ; 1920 3 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 1921 3 ! ; 1922 3 ! Now create the file ; 1923 3 ! ; 1924 3 STATUS = $CREATE (FAB = FILE_FAB); ; 1925 3 ; 1926 3 IF NOT .STATUS ; 1927 3 THEN ; 1928 4 BEGIN ; 1929 4 FILE_ERROR (.STATUS); ; 1930 4 RETURN KER_RMS32; ; 1931 3 END; ; 1932 3 ; P 1933 3 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = .REC_ADDRESS, ; 1934 3 ROP = <NLK, WAT>); ; 1935 3 STATUS = $CONNECT (RAB = FILE_RAB); ; 1936 3 ; 1937 3 IF NOT .STATUS ; 1938 3 THEN ; 1939 4 BEGIN ; 1940 4 FILE_ERROR (.STATUS); ; 1941 4 RETURN KER_RMS32; ; 1942 3 END; ; 1943 3 ; 1944 3 ! ; 1945 3 ! Set the initial state into the FAB field. This is used to remember ; 1946 3 ! whether we need to ignore the line feed which follows a carriage return. ; 1947 3 ! ; 1948 3 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 1949 3 FILE_REC_COUNT = 0; ; 1950 3 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1951 3 ! ; 1952 3 ! Tell user what name we ended up with for storing the file ; 1953 3 ! ; 1954 3 ; 1955 3 IF ( NOT .CONNECT_FLAG) AND .TY_FIL ; 1956 3 THEN ; 1957 4 BEGIN ; 1958 4 TT_TEXT (UPLIT (%ASCIZ' as ')); ; 1959 4 ; 1960 4 IF .FILE_NAM [NAM$B_RSL] GTR 0 ; 1961 4 THEN ; 1962 5 BEGIN ; 1963 5 CH$WCHAR (CHR_NUL, ; 1964 5 CH$PTR (.FILE_NAM [NAM$L_RSA], ; 1965 5 .FILE_NAM [NAM$B_RSL])); ; 1966 5 TT_TEXT (.FILE_NAM [NAM$L_RSA]); ; 1967 5 END ; 1968 4 ELSE ; 1969 5 BEGIN ; 1970 5 CH$WCHAR (CHR_NUL, ; 1971 5 CH$PTR (.FILE_NAM [NAM$L_ESA], ; 1972 5 .FILE_NAM [NAM$B_ESL])); ; 1973 5 TT_TEXT (.FILE_NAM [NAM$L_ESA]); ; 1974 4 END; ; 1975 4 ; 1976 4 TT_OUTPUT (); ; 1977 3 END; ; 1978 3 ; 1979 2 END; ; 1980 2 ; 1981 2 [OTHERWISE] : ; 1982 2 RETURN KER_INTERNALERR; ; 1983 2 TES; ; 1984 2 ; 1985 2 ! ; 1986 2 ! Copy the file name based on the type of file name we are to use. ; 1987 2 ! The possibilities are: ; 1988 2 ! Normal - Just copy name and type ; 1989 2 ! Full - Copy entire name string (either resultant or expanded) ; 1990 2 ! Untranslated - Copy string from name on (includes version, etc.) ; 1991 2 ; 1992 2 IF .DEV_CLASS EQL DC$_MAILBOX ; 1993 2 THEN ; 1994 3 BEGIN ; 1995 3 SIZE = 0; ; 1996 3 FILE_NAME = 0; ; 1997 3 END ; 1998 2 ELSE ; 1999 2 ; 2000 2 SELECTONE .FIL_NORMAL_FORM OF ; 2001 2 SET ; 2002 2 ; 2003 2 [FNM_FULL] : ; 2004 3 BEGIN ; 2005 3 ; 2006 3 IF .FILE_NAM [NAM$B_RSL] GTR 0 ; 2007 3 THEN ; 2008 4 BEGIN ; 2009 4 CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]), ; 2010 4 CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2011 4 SIZE = .FILE_NAM [NAM$B_RSL]; ; 2012 4 END ; 2013 3 ELSE ; 2014 4 BEGIN ; 2015 4 CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]), ; 2016 4 CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2017 4 SIZE = .FILE_NAM [NAM$B_ESL]; ; 2018 4 END ; 2019 4 ; 2020 2 END; ; 2021 2 ; 2022 2 [FNM_NORMAL, FNM_UNTRAN] : ; 2023 3 BEGIN ; 2024 3 CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]), ; 2025 3 .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL, ; 2026 3 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2027 3 SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE]; ; 2028 2 END; ; 2029 2 TES; ; 2030 2 ; 2031 2 IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE; ; 2032 2 ; 2033 2 RETURN KER_NORMAL; ; 2034 1 END; ! End of FILE_OPEN .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAA: .ASCII \.;0\ ; 30 3B 2E 00000 .BLKB 1 ; 00003 P.AAB: .ASCII \ as \<0><0><0><0> ; 00 00 00 00 20 73 61 20 00004 P.AAC: .ASCII \ as \<0><0><0><0> ; 00 00 00 00 20 73 61 20 0000C U.41= U.10 U.42= U.11 U.43= U.10 U.44= U.10 U.45= U.10 U.46= U.10 U.47= U.11 U.48= U.12 .EXTRN KER_INTERNALERR, TT_TEXT, SYS$GETDVIW, SYS$PARSE, SYS$SEARCH, SYS$CREATE .WEAK USER_FILE_CHECK .PSECT $CODE$,NOWRT,2 .ENTRY FILE_OPEN, ^M<R2,R3,R4,R5,R6,R7,-;FILE_OPEN, Save R2,R3,R4,R5,R6,R7,- 1631 0FFC 00000 R8,R9,R10,R11> ;R8,R9,R10,R11 SUBL2 #28, SP ;#28, SP 5E 1C C2 00002 MOVL #1, G^U.7 ;#1, U.7 1713 00000000' 00 01 D0 00005 MOVL #1, G^U.8 ;#1, U.8 1714 00000000' 00 01 D0 0000C MOVL 4(AP), R2 ;FUNCTION, R2 1718 52 04 AC D0 00013 MOVL R2, G^U.14 ;R2, U.14 00000000' 00 52 D0 00017 MOVW G^FILE_SIZE, G^FILE_DESC ;FILE_SIZE, FILE_DESC 1719 00000000' 00 00000000G 00 B0 0001E MOVAB G^USER_FILE_CHECK, R0 ;USER_FILE_CHECK, R0 1723 50 00000000G 00 9E 00029 CLRL R8 ;R8 58 D4 00030 TSTL R0 ;R0 50 D5 00032 BEQL 2$ ;2$ 26 13 00034 INCL R8 ;R8 58 D6 00036 CLRL (SP) ;(SP) 1726 6E D4 00038 TSTL G^U.14 ;U.14 00000000' 00 D5 0003A BNEQ 1$ ;1$ 02 12 00040 INCL (SP) ;(SP) 6E D6 00042 1$: PUSHL SP ;SP 5E DD 00044 PUSHAB G^FILE_DESC ;FILE_DESC 00000000' 00 9F 00046 CALLS #2, G^USER_FILE_CHECK ;#2, USER_FILE_CHECK 00000000G 00 02 FB 0004C MOVL R0, R7 ;R0, STATUS 57 50 D0 00053 BLBS R7, 2$ ;STATUS, 2$ 1727 03 57 E8 00056 BRW 22$ ;22$ 02F7 31 00059 2$: TSTL R2 ;R2 1741 52 D5 0005C BEQL 3$ ;3$ 03 13 0005E BRW 11$ ;11$ 016B 31 00060 3$: MOVL #262148, 12(SP) ;#262148, ITMLST 1746 0C AE 00040004 8F D0 00063 MOVAB G^U.8, 16(SP) ;U.8, ITMLST+4 1747 10 AE 00000000' 00 9E 0006B MOVAB 20(SP), 20(SP) ;ITMLST+8, ITMLST+8 1748 14 AE 14 AE 9E 00073 CLRL 24(SP) ;ITMLST+12 1749 18 AE D4 00078 CLRQ -(SP) ;-(SP) 1750 7E 7C 0007B CLRQ -(SP) ;-(SP) 7E 7C 0007D PUSHAB 28(SP) ;ITMLST 1C AE 9F 0007F PUSHAB G^FILE_DESC ;FILE_DESC 00000000' 00 9F 00082 CLRQ -(SP) ;-(SP) 7E 7C 00088 CALLS #8, G^SYS$GETDVIW ;#8, SYS$GETDVIW 00000000G 00 08 FB 0008A MOVL R0, R7 ;R0, STATUS 57 50 D0 00091 BLBC R7, 4$ ;STATUS, 4$ 1754 0F 57 E9 00094 CMPL G^U.8, #1 ;U.8, #1 01 00000000' 00 D1 00097 BEQL 4$ ;4$ 06 13 0009E CLRL G^U.7 ;U.7 00000000' 00 D4 000A0 4$: MOVC5 #0, (SP), #0, #80, G^U.41 ;#0, (SP), #0, #80, U.41 1760 6E 00 2C 000A6 ; 0050 8F 00 000A9 ; 00000000' 00 000AD MOVW #20483, G^U.41 ;#20483, U.41 00000000' 00 5003 8F B0 000B2 MOVL #16777216, G^U.41+4 ;#16777216, U.41+4 00000000' 00 01000000 8F D0 000BB MOVB #2, G^U.41+22 ;#2, U.41+22 00000000' 00 02 90 000C6 MOVB #2, G^U.41+31 ;#2, U.41+31 00000000' 00 02 90 000CD MOVAB G^U.11, G^U.41+40 ;U.11, U.41+40 00000000' 00 00000000' 00 9E 000D4 MOVAB G^FILE_NAME, G^U.41+44 ;FILE_NAME, U.41+44 00000000' 00 00000000G 00 9E 000DF MOVAB G^P.AAA, G^U.41+48 ;P.AAA, U.41+48 00000000' 00 00000000' 00 9E 000EA MOVB G^FILE_SIZE, G^U.41+52 ;FILE_SIZE, U.41+52 00000000' 00 00000000G 00 90 000F5 MOVB #3, G^U.41+53 ;#3, U.41+53 00000000' 00 03 90 00100 MOVC5 #0, (SP), #0, #96, G^U.42 ;#0, (SP), #0, #96, U.42 1765 6E 00 2C 00107 ; 0060 8F 00 0010A ; 00000000' 00 0010E MOVW #24578, G^U.42 ;#24578, U.42 00000000' 00 6002 8F B0 00113 MNEGB #1, G^U.42+2 ;#1, U.42+2 00000000' 00 01 8E 0011C MOVAB G^U.22, G^U.42+4 ;U.22, U.42+4 00000000' 00 00000000' 00 9E 00123 MNEGB #1, G^U.42+10 ;#1, U.42+10 00000000' 00 01 8E 0012E MOVAB G^U.21, G^U.42+12 ;U.21, U.42+12 00000000' 00 00000000' 00 9E 00135 PUSHAB G^U.10 ;U.10 1769 00000000' 00 9F 00140 CALLS #1, G^SYS$PARSE ;#1, SYS$PARSE 00000000G 00 01 FB 00146 MOVL R0, R7 ;R0, STATUS 57 50 D0 0014D BLBC R7, 5$ ;STATUS, 5$ 1771 17 57 E9 00150 BLBC G^U.7, 6$ ;U.7, 6$ 1778 16 00000000' 00 E9 00153 PUSHAB G^U.10 ;U.10 1781 00000000' 00 9F 0015A CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH 00000000G 00 01 FB 00160 MOVL R0, R7 ;R0, STATUS 57 50 D0 00167 5$: BLBS R7, 6$ ;STATUS, 6$ 1783 03 57 E8 0016A BRW 33$ ;33$ 0312 31 0016D 6$: CALLS #0, W^U.35 ;#0, U.35 1796 FD49 CF 00 FB 00170 MOVL R0, R7 ;R0, STATUS 57 50 D0 00175 BLBS R7, 7$ ;STATUS, 7$ 1798 03 57 E8 00178 BRW 23$ ;23$ 01DE 31 0017B 7$: BLBS G^CONNECT_FLAG, 10$ ;CONNECT_FLAG, 10$ 1804 46 00000000G 00 E8 0017E BLBC G^TY_FIL, 10$ ;TY_FIL, 10$ 3F 00000000G 00 E9 00185 TSTB G^U.11+2 ;U.11+2 1808 00000000' 00 95 0018C BEQL 8$ ;8$ 10 13 00192 MOVL G^U.11+4, R0 ;U.11+4, R0 1812 50 00000000' 00 D0 00194 MOVZBL G^U.11+3, R1 ;U.11+3, R1 1813 51 00000000' 00 9A 0019B BRB 9$ ;9$ 0E 11 001A2 8$: MOVL G^U.11+12, R0 ;U.11+12, R0 1819 50 00000000' 00 D0 001A4 MOVZBL G^U.11+11, R1 ;U.11+11, R1 1820 51 00000000' 00 9A 001AB 9$: CLRB (R1)[R0] ;(R1)[R0] 6140 94 001B2 PUSHL R0 ;R0 1821 50 DD 001B5 CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 001B7 PUSHAB G^P.AAB ;P.AAB 1824 00000000' 00 9F 001BE CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 001C4 10$: BRW 38$ ;38$ 1738 0335 31 001CB 11$: CMPL R2, #1 ;R2, #1 1829 01 52 D1 001CE BEQL 12$ ;12$ 03 13 001D1 BRW 37$ ;37$ 0325 31 001D3 12$: MOVL G^FILE_TYPE, R6 ;FILE_TYPE, R6 1832 56 00000000' 00 D0 001D6 CMPL R6, #1 ;R6, #1 1835 01 56 D1 001DD BNEQ 13$ ;13$ 32 12 001E0 MOVC5 #0, (SP), #0, #80, G^U.43 ;#0, (SP), #0, #80, U.43 1839 6E 00 2C 001E2 ; 0050 8F 00 001E5 ; 00000000' 00 001E9 MOVW #20483, G^U.43 ;#20483, U.43 00000000' 00 5003 8F B0 001EE MOVL #270532674, G^U.43+4 ;#270532674, U.43+4 00000000' 00 10200042 8F D0 001F7 MOVB #1, G^U.43+22 ;#1, U.43+22 00000000' 00 01 90 00202 MOVW #512, G^U.43+29 ;#512, U.43+29 00000000' 00 0200 8F B0 00209 BRB 14$ ;14$ 32 11 00212 13$: CMPL R6, #2 ;R6, #2 1842 02 56 D1 00214 BNEQ 15$ ;15$ 30 12 00217 MOVC5 #0, (SP), #0, #80, G^U.44 ;#0, (SP), #0, #80, U.44 1846 6E 00 2C 00219 ; 0050 8F 00 0021C ; 00000000' 00 00220 MOVW #20483, G^U.44 ;#20483, U.44 00000000' 00 5003 8F B0 00225 MOVL #270532674, G^U.44+4 ;#270532674, U.44+4 00000000' 00 10200042 8F D0 0022E MOVB #1, G^U.44+22 ;#1, U.44+22 00000000' 00 01 90 00239 CLRB G^U.44+29 ;U.44+29 00000000' 00 94 00240 14$: BRW 19$ ;19$ 00A4 31 00246 15$: CMPL R6, #4 ;R6, #4 1849 04 56 D1 00249 BNEQ 18$ ;18$ 73 12 0024C MOVC5 #0, (SP), #0, #80, G^U.45 ;#0, (SP), #0, #80, U.45 1855 6E 00 2C 0024E ; 0050 8F 00 00251 ; 00000000' 00 00255 MOVW #20483, G^U.45 ;#20483, U.45 00000000' 00 5003 8F B0 0025A MOVL #270532674, G^U.45+4 ;#270532674, U.45+4 00000000' 00 10200042 8F D0 00263 MOVB #1, G^U.45+22 ;#1, U.45+22 00000000' 00 01 90 0026E CLRB G^U.45+29 ;U.45+29 00000000' 00 94 00275 MOVB #1, G^U.45+31 ;#1, U.45+31 00000000' 00 01 90 0027B MOVAB G^U.11, G^U.45+40 ;U.11, U.45+40 00000000' 00 00000000' 00 9E 00282 MOVAB G^FILE_NAME, G^U.45+44 ;FILE_NAME, U.45+44 00000000' 00 00000000G 00 9E 0028D MOVB G^FILE_SIZE, G^U.45+52 ;FILE_SIZE, U.45+52 00000000' 00 00000000G 00 90 00298 BLBC G^FILE_BLOCKSIZE_SET, 16$ ;FILE_BLOCKSIZE_SET, 16$ 09 00000000' 00 E9 002A3 MOVL G^FILE_BLOCKSIZE, R0 ;FILE_BLOCKSIZE, R0 50 00000000' 00 D0 002AA BRB 17$ ;17$ 05 11 002B1 16$: MOVZWL #512, R0 ;#512, R0 50 0200 8F 3C 002B3 17$: MOVW R0, G^U.45+54 ;R0, U.45+54 00000000' 00 50 B0 002B8 BRB 20$ ;20$ 54 11 002BF 18$: CMPL R6, #3 ;R6, #3 1858 03 56 D1 002C1 BNEQ 20$ ;20$ 4F 12 002C4 MOVC5 #0, (SP), #0, #80, G^U.46 ;#0, (SP), #0, #80, U.46 1861 6E 00 2C 002C6 ; 0050 8F 00 002C9 ; 00000000' 00 002CD MOVW #20483, G^U.46 ;#20483, U.46 00000000' 00 5003 8F B0 002D2 MOVL #270532674, G^U.46+4 ;#270532674, U.46+4 00000000' 00 10200042 8F D0 002DB MOVB #33, G^U.46+22 ;#33, U.46+22 00000000' 00 21 90 002E6 19$: MOVB #2, G^U.46+31 ;#2, U.46+31 00000000' 00 02 90 002ED MOVAB G^U.11, G^U.46+40 ;U.11, U.46+40 00000000' 00 00000000' 00 9E 002F4 MOVAB G^FILE_NAME, G^U.46+44 ;FILE_NAME, U.46+44 00000000' 00 00000000G 00 9E 002FF MOVB G^FILE_SIZE, G^U.46+52 ;FILE_SIZE, U.46+52 00000000' 00 00000000G 00 90 0030A 20$: MOVL G^ALT_FILE_SIZE, R0 ;ALT_FILE_SIZE, R0 1870 50 00000000G 00 D0 00315 BLEQ 25$ ;25$ 58 15 0031C MOVL G^FILE_DESC, 4(SP) ;FILE_DESC, ALT_FILE_DESC 1876 04 AE 00000000' 00 D0 0031E MOVW R0, 4(SP) ;R0, ALT_FILE_DESC 1877 04 AE 50 B0 00326 MOVAB G^ALT_FILE_NAME, 8(SP) ;ALT_FILE_NAME, ALT_FILE_DESC+4 1878 08 AE 00000000G 00 9E 0032A BLBC R8, 24$ ;R8, 24$ 1879 2B 58 E9 00332 CLRL (SP) ;(SP) 1882 6E D4 00335 TSTL G^U.14 ;U.14 00000000' 00 D5 00337 BNEQ 21$ ;21$ 02 12 0033D INCL (SP) ;(SP) 6E D6 0033F 21$: PUSHL SP ;SP 5E DD 00341 PUSHAB 8(SP) ;ALT_FILE_DESC 08 AE 9F 00343 CALLS #2, G^USER_FILE_CHECK ;#2, USER_FILE_CHECK 00000000G 00 02 FB 00346 MOVL R0, R7 ;R0, STATUS 57 50 D0 0034D BLBS R7, 24$ ;STATUS, 24$ 1883 0D 57 E8 00350 22$: PUSHL R7 ;STATUS 1886 57 DD 00353 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 00355 23$: MOVL R7, R0 ;STATUS, R0 1887 50 57 D0 0035C RET ; 04 0035F 24$: MOVAB G^ALT_FILE_NAME, G^U.10+44 ;ALT_FILE_NAME, U.10+44 1890 00000000' 00 00000000G 00 9E 00360 MOVB G^ALT_FILE_SIZE, G^U.10+52 ;ALT_FILE_SIZE, U.10+52 1891 00000000' 00 00000000G 00 90 0036B 25$: MOVC5 #0, (SP), #0, #96, G^U.47 ;#0, (SP), #0, #96, U.47 1895 6E 00 2C 00376 ; 0060 8F 00 00379 ; 00000000' 00 0037D MOVW #24578, G^U.47 ;#24578, U.47 00000000' 00 6002 8F B0 00382 MNEGB #1, G^U.47+2 ;#1, U.47+2 00000000' 00 01 8E 0038B MOVAB G^U.22, G^U.47+4 ;U.22, U.47+4 00000000' 00 00000000' 00 9E 00392 MNEGB #1, G^U.47+10 ;#1, U.47+10 00000000' 00 01 8E 0039D MOVAB G^U.21, G^U.47+12 ;U.21, U.47+12 00000000' 00 00000000' 00 9E 003A4 MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 1901 50 00000000' 00 D0 003AF CMPL R0, #1 ;R0, #1 1904 01 50 D1 003B6 BNEQ 26$ ;26$ 0B 12 003B9 MOVZWL #4096, G^U.17 ;#4096, U.17 1905 00000000' 00 1000 8F 3C 003BB BRB 32$ ;32$ 44 11 003C4 26$: CMPL R0, #2 ;R0, #2 1907 02 50 D1 003C6 BNEQ 27$ ;27$ 0E 12 003C9 BLBS G^FILE_BLOCKSIZE_SET, 29$ ;FILE_BLOCKSIZE_SET, 29$ 1908 23 00000000' 00 E8 003CB MOVZWL #510, R0 ;#510, R0 1909 50 01FE 8F 3C 003D2 BRB 31$ ;31$ 1908 2A 11 003D7 27$: CMPL R0, #3 ;R0, #3 1911 03 50 D1 003D9 BNEQ 28$ ;28$ 0B 12 003DC MOVZWL #512, G^U.17 ;#512, U.17 1912 00000000' 00 0200 8F 3C 003DE BRB 32$ ;32$ 21 11 003E7 28$: CMPL R0, #4 ;R0, #4 1914 04 50 D1 003E9 BNEQ 32$ ;32$ 1C 12 003EC BLBC G^FILE_BLOCKSIZE_SET, 30$ ;FILE_BLOCKSIZE_SET, 30$ 1915 09 00000000' 00 E9 003EE 29$: MOVL G^FILE_BLOCKSIZE, R0 ;FILE_BLOCKSIZE, R0 50 00000000' 00 D0 003F5 BRB 31$ ;31$ 05 11 003FC 30$: MOVZWL #512, R0 ;#512, R0 1916 50 0200 8F 3C 003FE 31$: MOVL R0, G^U.17 ;R0, U.17 1915 00000000' 00 50 D0 00403 32$: PUSHAB G^U.18 ;U.18 1920 00000000' 00 9F 0040A PUSHAB G^U.17 ;U.17 00000000' 00 9F 00410 CALLS #2, G^LIB$GET_VM ;#2, LIB$GET_VM 00000000G 00 02 FB 00416 MOVL R0, R7 ;R0, STATUS 57 50 D0 0041D PUSHAB G^U.10 ;U.10 1924 00000000' 00 9F 00420 CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE 00000000G 00 01 FB 00426 MOVL R0, R7 ;R0, STATUS 57 50 D0 0042D BLBC R7, 33$ ;STATUS, 33$ 1926 4F 57 E9 00430 MOVC5 #0, (SP), #0, #68, G^U.48 ;#0, (SP), #0, #68, U.48 1934 6E 00 2C 00433 ; 0044 8F 00 00436 ; 00000000' 00 0043A MOVW #17409, G^U.48 ;#17409, U.48 00000000' 00 4401 8F B0 0043F MOVL #1179648, G^U.48+4 ;#1179648, U.48+4 00000000' 00 00120000 8F D0 00448 CLRB G^U.48+30 ;U.48+30 00000000' 00 94 00453 MOVL G^U.18, G^U.48+40 ;U.18, U.48+40 00000000' 00 00000000' 00 D0 00459 MOVAB G^U.10, G^U.48+60 ;U.10, U.48+60 00000000' 00 00000000' 00 9E 00464 PUSHAB G^U.12 ;U.12 1935 00000000' 00 9F 0046F CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT 00000000G 00 01 FB 00475 MOVL R0, R7 ;R0, STATUS 57 50 D0 0047C BLBS R7, 34$ ;STATUS, 34$ 1937 11 57 E8 0047F 33$: PUSHL R7 ;STATUS 1940 57 DD 00482 CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00484 MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1941 50 00000000G 8F D0 0048B RET ; 04 00492 34$: MOVL #2, G^U.10+24 ;#2, U.10+24 1948 00000000' 00 02 D0 00493 CLRL G^U.16 ;U.16 1949 00000000' 00 D4 0049A MOVL G^U.18, G^U.15 ;U.18, U.15 1950 00000000' 00 00000000' 00 D0 004A0 BLBS G^CONNECT_FLAG, 38$ ;CONNECT_FLAG, 38$ 1955 51 00000000G 00 E8 004AB BLBC G^TY_FIL, 38$ ;TY_FIL, 38$ 4A 00000000G 00 E9 004B2 PUSHAB G^P.AAC ;P.AAC 1958 00000000' 00 9F 004B9 CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 004BF MOVZBL G^U.11+3, R1 ;U.11+3, R1 1960 51 00000000' 00 9A 004C6 BLEQ 35$ ;35$ 09 15 004CD MOVL G^U.11+4, R0 ;U.11+4, R0 1964 50 00000000' 00 D0 004CF BRB 36$ ;36$ 1965 0E 11 004D6 35$: MOVL G^U.11+12, R0 ;U.11+12, R0 1971 50 00000000' 00 D0 004D8 MOVZBL G^U.11+11, R1 ;U.11+11, R1 1972 51 00000000' 00 9A 004DF 36$: CLRB (R1)[R0] ;(R1)[R0] 6140 94 004E6 PUSHL R0 ;R0 1973 50 DD 004E9 CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 004EB CALLS #0, G^TT_OUTPUT ;#0, TT_OUTPUT 1976 00000000G 00 00 FB 004F2 BRB 38$ ;38$ 1738 08 11 004F9 37$: MOVL #KER_INTERNALERR, R0 ;#KER_INTERNALERR, R0 1982 50 00000000G 8F D0 004FB RET ; 04 00502 38$: CMPL G^U.8, #160 ;U.8, #160 1992 000000A0 8F 00000000' 00 D1 00503 BNEQ 39$ ;39$ 0A 12 0050E CLRW R6 ;SIZE 1995 56 B4 00510 CLRL G^FILE_NAME ;FILE_NAME 1996 00000000G 00 D4 00512 BRB 42$ ;42$ 3B 11 00518 39$: MOVL G^FIL_NORMAL_FORM, R0 ;FIL_NORMAL_FORM, R0 2000 50 00000000G 00 D0 0051A CMPL R0, #2 ;R0, #2 2003 02 50 D1 00521 BNEQ 43$ ;43$ 31 12 00524 MOVZBL G^U.11+3, R7 ;U.11+3, R7 2006 57 00000000' 00 9A 00526 BLEQ 40$ ;40$ 09 15 0052D MOVL G^U.11+4, R0 ;U.11+4, R0 2009 50 00000000' 00 D0 0052F BRB 41$ ;41$ 2010 0E 11 00536 40$: MOVZBL G^U.11+11, R7 ;U.11+11, R7 2015 57 00000000' 00 9A 00538 MOVL G^U.11+12, R0 ;U.11+12, R0 50 00000000' 00 D0 0053F 41$: MOVC5 R7, (R0), #0, #132, G^FILE_NAME ;R7, (R0), #0, #132, FILE_NAME 2016 60 57 2C 00546 ; 0084 8F 00 00549 ; 00000000G 00 0054D MOVW R7, R6 ;R7, SIZE 2017 56 57 B0 00552 42$: BRB 46$ ;46$ 2000 49 11 00555 43$: CMPL R0, #1 ;R0, #1 2022 01 50 D1 00557 BEQL 44$ ;44$ 05 13 0055A CMPL R0, #4 ;R0, #4 04 50 D1 0055C BNEQ 46$ ;46$ 3F 12 0055F 44$: MOVZBL G^U.11+59, R9 ;U.11+59, R9 2024 59 00000000' 00 9A 00561 MOVL G^U.11+76, R0 ;U.11+76, R0 50 00000000' 00 D0 00568 MOVZBL G^U.11+60, R8 ;U.11+60, R8 2025 58 00000000' 00 9A 0056F MOVL G^U.11+80, R11 ;U.11+80, R11 5B 00000000' 00 D0 00576 MOVZBL #132, R10 ;#132, R10 2026 5A 84 8F 9A 0057D MOVAB G^FILE_NAME, R7 ;FILE_NAME, R7 57 00000000G 00 9E 00581 MOVC5 R9, (R0), #0, R10, (R7) ;R9, (R0), #0, R10, (R7) 60 59 2C 00588 ; 5A 00 0058B ; 67 0058D BGEQ 45$ ;45$ 0C 18 0058E ADDL2 R9, R7 ;R9, R7 57 59 C0 00590 SUBL2 R9, R10 ;R9, R10 5A 59 C2 00593 MOVC5 R8, (R11), #0, R10, (R7) ;R8, (R11), #0, R10, (R7) 6B 58 2C 00596 ; 5A 00 00599 ; 67 0059B 45$: ADDW3 R8, R9, R6 ;R8, R9, SIZE 2027 59 58 A1 0059C ; 56 0059F 46$: CMPW R6, #132 ;SIZE, #132 2031 0084 8F 56 B1 005A0 BLEQU 47$ ;47$ 0A 1B 005A5 MOVZBL #132, G^FILE_SIZE ;#132, FILE_SIZE 00000000G 00 84 8F 9A 005A7 BRB 48$ ;48$ 07 11 005AF 47$: MOVZWL R6, G^FILE_SIZE ;SIZE, FILE_SIZE 00000000G 00 56 3C 005B1 48$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2033 50 00000000G 8F D0 005B8 RET ; 04 005BF ; Routine Size: 1472 bytes, Routine Base: $CODE$ + 0617 ; 2035 1 ; 2036 1 %SBTTL 'FILE_CLOSE' ; 2037 1 ; 2038 1 GLOBAL ROUTINE FILE_CLOSE (ABORT_FLAG) = ; 2039 1 ; 2040 1 !++ ; 2041 1 ! FUNCTIONAL DESCRIPTION: ; 2042 1 ! ; 2043 1 ! This routine will close a file that was opened by FILE_OPEN. ; 2044 1 ! It assumes any data associated with the file is stored in this ; 2045 1 ! module, since this routine is called by KERMSG. ; 2046 1 ! ; 2047 1 ! CALLING SEQUENCE: ; 2048 1 ! ; 2049 1 ! FILE_CLOSE(); ; 2050 1 ! ; 2051 1 ! INPUT PARAMETERS: ; 2052 1 ! ; 2053 1 ! ABORT_FLAG - True if file should not be saved. ; 2054 1 ! ; 2055 1 ! IMPLICIT INPUTS: ; 2056 1 ! ; 2057 1 ! None. ; 2058 1 ! ; 2059 1 ! OUTPUT PARAMETERS: ; 2060 1 ! ; 2061 1 ! None. ; 2062 1 ! ; 2063 1 ! IMPLICIT OUTPUTS: ; 2064 1 ! ; 2065 1 ! None. ; 2066 1 ! ; 2067 1 ! COMPLETION CODES: ; 2068 1 ! ; 2069 1 ! None. ; 2070 1 ! ; 2071 1 ! SIDE EFFECTS: ; 2072 1 ! ; 2073 1 ! None. ; 2074 1 ! ; 2075 1 !-- ; 2076 1 ; 2077 2 BEGIN ; 2078 2 ! ; 2079 2 ! Completion codes returned: ; 2080 2 ! ; 2081 2 EXTERNAL LITERAL ; 2082 2 KER_NORMAL, ! Normal return ; 2083 2 KER_RMS32; ! RMS-32 error ; 2084 2 ; 2085 2 LOCAL ; 2086 2 STATUS; ! Random status values ; 2087 2 ; 2088 2 ! ; 2089 2 ! If there might be something left to write ; 2090 2 ; 2091 2 ! ; 2092 2 ; 2093 3 IF .FILE_MODE EQL FNC_WRITE AND (.FILE_REC_COUNT GTR 0 OR .FILE_FAB [FAB$L_CTX] NEQ ; 2094 3 F_STATE_DATA) ; 2095 2 THEN ; 2096 3 BEGIN ; 2097 3 ; 2098 3 SELECTONE .FILE_TYPE OF ; 2099 3 SET ; 2100 3 ; 2101 3 [FILE_FIX] : ; 2102 4 BEGIN ; 2103 4 ; 2104 4 INCR I FROM .FILE_REC_COUNT TO .REC_SIZE - 1 DO ; 2105 4 CH$WCHAR_A (CHR_NUL, FILE_REC_POINTER); ; 2106 4 FILE_REC_COUNT = .REC_SIZE; ! Store the byte count ; 2107 4 STATUS = DUMP_BUFFER (); ; 2108 3 END; ; 2109 3 ; 2110 3 [FILE_ASC, FILE_BIN] : ; 2111 3 STATUS = DUMP_BUFFER (); ; 2112 3 ; 2113 3 [FILE_BLK] : ; 2114 4 BEGIN ; 2115 4 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 2116 4 STATUS = $WRITE (RAB = FILE_RAB); ; 2117 4 ; 2118 4 IF NOT .STATUS ; 2119 4 THEN ; 2120 5 BEGIN ; 2121 5 FILE_ERROR (.STATUS); ; 2122 5 STATUS = KER_RMS32; ; 2123 5 END ; 2124 4 ELSE ; 2125 4 STATUS = KER_NORMAL; ; 2126 4 ; 2127 3 END; ; 2128 3 TES; ; 2129 3 ; 2130 3 IF NOT .STATUS THEN RETURN .STATUS; ; 2131 3 ; 2132 2 END; ; 2133 2 ; 2134 2 ! ; 2135 2 ! If reading from a mailbox, read until EOF to allow the process on the other ; 2136 2 ! end to terminal gracefully. ; 2137 2 ! ; 2138 2 ; 2139 2 IF .FILE_MODE EQL FNC_READ AND .DEV_CLASS EQL DC$_MAILBOX AND NOT .EOF_FLAG ; 2140 2 THEN ; 2141 2 ; 2142 2 DO ; 2143 2 STATUS = GET_BUFFER () ; 2144 2 UNTIL ( NOT .STATUS) OR .EOF_FLAG; ; 2145 2 ; 2146 2 STATUS = LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ; 2147 2 ; 2148 2 IF .FIX_SIZE NEQ 0 THEN STATUS = LIB$FREE_VM (FIX_SIZE, FIX_ADDRESS); ; 2149 2 ; 2150 2 IF .ABORT_FLAG AND .FILE_MODE EQL FNC_WRITE ; 2151 2 THEN ; 2152 2 FILE_FAB [FAB$V_DLT] = TRUE ; 2153 2 ELSE ; 2154 2 FILE_FAB [FAB$V_DLT] = FALSE; ; 2155 2 ; 2156 2 STATUS = $CLOSE (FAB = FILE_FAB); ; 2157 2 EOF_FLAG = FALSE; ; 2158 2 ; 2159 2 IF NOT .STATUS ; 2160 2 THEN ; 2161 3 BEGIN ; 2162 3 FILE_ERROR (.STATUS); ; 2163 3 RETURN KER_RMS32; ; 2164 3 END ; 2165 2 ELSE ; 2166 2 RETURN KER_NORMAL; ; 2167 2 ; 2168 1 END; ! End of FILE_CLOSE .EXTRN SYS$CLOSE .ENTRY FILE_CLOSE, ^M<R2,R3,R4,R5,R6,- ;FILE_CLOSE, Save R2,R3,R4,R5,R6,R7 2038 00FC 00000 R7> ; MOVAB G^LIB$FREE_VM, R7 ;LIB$FREE_VM, R7 57 00000000G 00 9E 00002 MOVL #KER_NORMAL, R6 ;#KER_NORMAL, R6 56 00000000G 8F D0 00009 MOVL #KER_RMS32, R5 ;#KER_RMS32, R5 55 00000000G 8F D0 00010 MOVAB G^U.6, R4 ;U.6, R4 54 00000000V 00 9E 00017 MOVAB G^U.16, R3 ;U.16, R3 53 00000000' 00 9E 0001E CMPL -8(R3), #1 ;FILE_MODE, #1 2093 01 F8 A3 D1 00025 BNEQ 9$ ;9$ 73 12 00029 TSTL (R3) ;FILE_REC_COUNT 63 D5 0002B BGTR 1$ ;1$ 07 14 0002D CMPL -272(R3), #2 ;FILE_FAB+24, #2 2094 02 FEF0 C3 D1 0002F BEQL 9$ ;9$ 68 13 00034 1$: MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 2098 50 00000000' 00 D0 00036 CMPL R0, #4 ;R0, #4 2101 04 50 D1 0003D BNEQ 4$ ;4$ 1C 12 00040 MOVL 4(R3), R1 ;REC_SIZE, R1 2104 51 04 A3 D0 00042 SUBL3 #1, (R3), R2 ;#1, FILE_REC_COUNT, I 63 01 C3 00046 ; 52 00049 BRB 3$ ;3$ 09 11 0004A 2$: MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 2105 50 FC A3 D0 0004C CLRB (R0) ;(R0) 60 94 00050 INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 00052 3$: AOBLSS R1, R2, 2$ ;R1, I, 2$ 52 51 F2 00055 ; F3 00058 MOVL R1, (R3) ;R1, FILE_REC_COUNT 2106 63 51 D0 00059 BRB 5$ ;5$ 2107 09 11 0005C 4$: TSTL R0 ;R0 2110 50 D5 0005E BLEQ 6$ ;6$ 0F 15 00060 CMPL R0, #2 ;R0, #2 02 50 D1 00062 BGTR 6$ ;6$ 0A 14 00065 5$: CALLS #0, W^U.2 ;#0, U.2 2111 F858 CF 00 FB 00067 MOVL R0, R2 ;R0, STATUS 52 50 D0 0006C BRB 8$ ;8$ 26 11 0006F 6$: CMPL R0, #3 ;R0, #3 2113 03 50 D1 00071 BNEQ 8$ ;8$ 21 12 00074 MOVW (R3), -86(R3) ;FILE_REC_COUNT, FILE_RAB+34 2115 AA A3 63 B0 00076 PUSHAB -120(R3) ;FILE_RAB 2116 88 A3 9F 0007A CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE 00000000G 00 01 FB 0007D MOVL R0, R2 ;R0, STATUS 52 50 D0 00084 BLBS R2, 7$ ;STATUS, 7$ 2118 0A 52 E8 00087 PUSHL R2 ;STATUS 2121 52 DD 0008A CALLS #1, (R4) ;#1, FILE_ERROR 64 01 FB 0008C MOVL R5, R2 ;R5, STATUS 2122 52 55 D0 0008F BRB 8$ ;8$ 03 11 00092 7$: MOVL R6, R2 ;R6, STATUS 2125 52 56 D0 00094 8$: BLBS R2, 9$ ;STATUS, 9$ 2130 04 52 E8 00097 MOVL R2, R0 ;STATUS, R0 50 52 D0 0009A RET ; 04 0009D 9$: TSTL -8(R3) ;FILE_MODE 2139 F8 A3 D5 0009E BNEQ 11$ ;11$ 20 12 000A1 CMPL -304(R3), #160 ;DEV_CLASS, #160 000000A0 8F FED0 C3 D1 000A3 BNEQ 11$ ;11$ 15 12 000AC BLBS -300(R3), 11$ ;EOF_FLAG, 11$ 10 FED4 C3 E8 000AE 10$: CALLS #0, W^U.3 ;#0, U.3 2143 F6E0 CF 00 FB 000B3 MOVL R0, R2 ;R0, STATUS 52 50 D0 000B8 BLBC R2, 11$ ;STATUS, 11$ 2144 05 52 E9 000BB BLBC -300(R3), 10$ ;EOF_FLAG, 10$ F0 FED4 C3 E9 000BE 11$: PUSHAB 8(R3) ;REC_ADDRESS 2146 08 A3 9F 000C3 PUSHAB 4(R3) ;REC_SIZE 04 A3 9F 000C6 CALLS #2, (R7) ;#2, LIB$FREE_VM 67 02 FB 000C9 MOVL R0, R2 ;R0, STATUS 52 50 D0 000CC TSTL 12(R3) ;FIX_SIZE 2148 0C A3 D5 000CF BEQL 12$ ;12$ 0C 13 000D2 PUSHAB 16(R3) ;FIX_ADDRESS 10 A3 9F 000D4 PUSHAB 12(R3) ;FIX_SIZE 0C A3 9F 000D7 CALLS #2, (R7) ;#2, LIB$FREE_VM 67 02 FB 000DA MOVL R0, R2 ;R0, STATUS 52 50 D0 000DD 12$: BLBC 4(AP), 13$ ;ABORT_FLAG, 13$ 2150 0E 04 AC E9 000E0 CMPL -8(R3), #1 ;FILE_MODE, #1 01 F8 A3 D1 000E4 BNEQ 13$ ;13$ 08 12 000E8 BISB2 #128, -291(R3) ;#128, FILE_FAB+5 2152 FEDD C3 80 8F 88 000EA BRB 14$ ;14$ 06 11 000F0 13$: BICB2 #128, -291(R3) ;#128, FILE_FAB+5 2154 FEDD C3 80 8F 8A 000F2 14$: PUSHAB -296(R3) ;FILE_FAB 2156 FED8 C3 9F 000F8 CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE 00000000G 00 01 FB 000FC MOVL R0, R2 ;R0, STATUS 52 50 D0 00103 CLRL -300(R3) ;EOF_FLAG 2157 FED4 C3 D4 00106 BLBS R2, 15$ ;STATUS, 15$ 2159 09 52 E8 0010A PUSHL R2 ;STATUS 2162 52 DD 0010D CALLS #1, (R4) ;#1, FILE_ERROR 64 01 FB 0010F MOVL R5, R0 ;R5, R0 2163 50 55 D0 00112 RET ; 04 00115 15$: MOVL R6, R0 ;R6, R0 2166 50 56 D0 00116 RET ; 04 00119 ; Routine Size: 282 bytes, Routine Base: $CODE$ + 0BD7 ; 2169 1 ; 2170 1 %SBTTL 'NEXT_FILE' ; 2171 1 ; 2172 1 GLOBAL ROUTINE NEXT_FILE = ; 2173 1 ; 2174 1 !++ ; 2175 1 ! FUNCTIONAL DESCRIPTION: ; 2176 1 ! ; 2177 1 ! This routine will cause the next file to be opened. It will ; 2178 1 ! call the RMS-32 routine $SEARCH and $OPEN for the file. ; 2179 1 ! ; 2180 1 ! CALLING SEQUENCE: ; 2181 1 ! ; 2182 1 ! STATUS = NEXT_FILE; ; 2183 1 ! ; 2184 1 ! INPUT PARAMETERS: ; 2185 1 ! ; 2186 1 ! None. ; 2187 1 ! ; 2188 1 ! IMPLICIT INPUTS: ; 2189 1 ! ; 2190 1 ! FAB/NAM blocks set up from previous processing. ; 2191 1 ! ; 2192 1 ! OUTPUT PARAMETERS: ; 2193 1 ! ; 2194 1 ! None. ; 2195 1 ! ; 2196 1 ! IMPLICIT OUTPUTS: ; 2197 1 ! ; 2198 1 ! FAB/NAM blocks set up for the next file. ; 2199 1 ! ; 2200 1 ! COMPLETION CODES: ; 2201 1 ! ; 2202 1 ! TRUE - There is a next file. ; 2203 1 ! KER_RMS32 - No next file. ; 2204 1 ! ; 2205 1 ! SIDE EFFECTS: ; 2206 1 ! ; 2207 1 ! None. ; 2208 1 ! ; 2209 1 !-- ; 2210 1 ; 2211 2 BEGIN ; 2212 2 ! ; 2213 2 ! Completion codes returned: ; 2214 2 ! ; 2215 2 EXTERNAL LITERAL ; 2216 2 KER_NORMAL, ! Normal return ; 2217 2 KER_NOMORFILES, ! No more files to read ; 2218 2 KER_RMS32; ! RMS-32 error ; 2219 2 ; 2220 2 EXTERNAL ROUTINE ; 2221 2 TT_TEXT : NOVALUE; ! Output an ASCIZ string ; 2222 2 ; 2223 2 LOCAL ; 2224 2 SIZE : WORD, ! Size of the $FAO string ; 2225 2 STATUS; ! Random status values ; 2226 2 ; 2227 2 ! ; 2228 2 ! If we can't do a search, just return no more files ; 2229 2 ! ; 2230 2 ; 2231 2 IF NOT .SEARCH_FLAG THEN RETURN KER_NOMORFILES; ; 2232 2 ; 2233 2 ! ; 2234 2 ! Now search for the next file that we want to process. ; 2235 2 ! ; 2236 2 STATUS = $SEARCH (FAB = FILE_FAB); ; 2237 2 ; 2238 2 IF .STATUS EQL RMS$_NMF THEN RETURN KER_NOMORFILES; ; 2239 2 ; 2240 2 IF NOT .STATUS ; 2241 2 THEN ; 2242 3 BEGIN ; 2243 3 FILE_ERROR (.STATUS); ; 2244 3 RETURN KER_RMS32; ; 2245 2 END; ; 2246 2 ; 2247 2 ! ; 2248 2 ! Now we have the new file name. All that we have to do is open the file ; 2249 2 ! for reading now. ; 2250 2 ! ; 2251 2 STATUS = OPEN_READING (); ; 2252 2 ; 2253 2 IF NOT .STATUS THEN RETURN .STATUS; ; 2254 2 ; 2255 2 ! ; 2256 2 ! Copy the file name based on the type of file name we are to use. ; 2257 2 ! The possibilities are: ; 2258 2 ! Normal - Just copy name and type ; 2259 2 ! Full - Copy entire name string (either resultant or expanded) ; 2260 2 ! Untranslated - Copy string from name on (includes version, etc.) ; 2261 2 ; 2262 2 SELECTONE .FIL_NORMAL_FORM OF ; 2263 2 SET ; 2264 2 ; 2265 2 [FNM_FULL] : ; 2266 3 BEGIN ; 2267 3 ; 2268 3 IF .FILE_NAM [NAM$B_RSL] GTR 0 ; 2269 3 THEN ; 2270 4 BEGIN ; 2271 4 CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]), CHR_NUL, ; 2272 4 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2273 4 SIZE = .FILE_NAM [NAM$B_RSL]; ; 2274 4 END ; 2275 3 ELSE ; 2276 4 BEGIN ; 2277 4 CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]), CHR_NUL, ; 2278 4 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2279 4 SIZE = .FILE_NAM [NAM$B_ESL]; ; 2280 4 END ; 2281 4 ; 2282 2 END; ; 2283 2 ; 2284 2 [FNM_NORMAL, FNM_UNTRAN] : ; 2285 3 BEGIN ; 2286 3 CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]), ; 2287 3 .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL, ; 2288 3 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2289 3 SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE]; ; 2290 2 END; ; 2291 2 TES; ; 2292 2 ; 2293 2 IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE; ; 2294 2 ; 2295 2 ! ; 2296 2 ! Put prompt for NEXT_FILE sending in here ; 2297 2 ! ; 2298 2 IF ( NOT .CONNECT_FLAG) AND .TY_FIL ; 2299 2 THEN ; 2300 3 BEGIN ; 2301 3 TT_TEXT (UPLIT (%ASCIZ 'Sending: ')); ; 2302 3 .FILE_NAM [NAM$L_RSA] + .FILE_NAM [NAM$B_RSL] = 0; ; 2303 3 TT_TEXT (.FILE_NAM [NAM$L_RSA]); ; 2304 3 TT_TEXT (UPLIT (%ASCIZ ' as ')); ; 2305 3 TT_OUTPUT (); ; 2306 2 END; ; 2307 2 ; 2308 2 RETURN KER_NORMAL; ; 2309 1 END; ! End of NEXT_FILE .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAD: .ASCII \Sending: \<0><0><0> ; 3A 67 6E 69 64 6E 65 53 00014 ; 00 00 00 20 0001C P.AAE: .ASCII \ as \<0><0><0><0> ; 00 00 00 00 20 73 61 20 00020 .EXTRN KER_NOMORFILES .PSECT $CODE$,NOWRT,2 .ENTRY NEXT_FILE, ^M<R2,R3,R4,R5,R6,R7,-;NEXT_FILE, Save R2,R3,R4,R5,R6,R7,- 2172 0FFC 00000 R8,R9,R10,R11> ;R8,R9,R10,R11 BLBC G^U.7, 1$ ;U.7, 1$ 2231 19 00000000' 00 E9 00002 PUSHAB G^U.10 ;U.10 2236 00000000' 00 9F 00009 CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH 00000000G 00 01 FB 0000F MOVL R0, R2 ;R0, STATUS 52 50 D0 00016 CMPL R2, #99018 ;STATUS, #99018 2238 000182CA 8F 52 D1 00019 BNEQ 2$ ;2$ 08 12 00020 1$: MOVL #KER_NOMORFILES, R0 ;#KER_NOMORFILES, R0 50 00000000G 8F D0 00022 RET ; 04 00029 2$: BLBS R2, 3$ ;STATUS, 3$ 2240 11 52 E8 0002A PUSHL R2 ;STATUS 2243 52 DD 0002D CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 0002F MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 2244 50 00000000G 8F D0 00036 RET ; 04 0003D 3$: CALLS #0, W^U.35 ;#0, U.35 2251 F7A1 CF 00 FB 0003E MOVL R0, R2 ;R0, STATUS 52 50 D0 00043 BLBS R2, 4$ ;STATUS, 4$ 2253 04 52 E8 00046 MOVL R2, R0 ;STATUS, R0 50 52 D0 00049 RET ; 04 0004C 4$: MOVL G^FIL_NORMAL_FORM, R0 ;FIL_NORMAL_FORM, R0 2262 50 00000000G 00 D0 0004D CMPL R0, #2 ;R0, #2 2265 02 50 D1 00054 BNEQ 7$ ;7$ 31 12 00057 MOVZBL G^U.11+3, R6 ;U.11+3, R6 2268 56 00000000' 00 9A 00059 BLEQ 5$ ;5$ 09 15 00060 MOVL G^U.11+4, R0 ;U.11+4, R0 2271 50 00000000' 00 D0 00062 BRB 6$ ;6$ 2272 0E 11 00069 5$: MOVZBL G^U.11+11, R6 ;U.11+11, R6 2277 56 00000000' 00 9A 0006B MOVL G^U.11+12, R0 ;U.11+12, R0 50 00000000' 00 D0 00072 6$: MOVC5 R6, (R0), #0, #132, G^FILE_NAME ;R6, (R0), #0, #132, FILE_NAME 2278 60 56 2C 00079 ; 0084 8F 00 0007C ; 00000000G 00 00080 MOVW R6, R7 ;R6, SIZE 2279 57 56 B0 00085 BRB 10$ ;10$ 2262 49 11 00088 7$: CMPL R0, #1 ;R0, #1 2284 01 50 D1 0008A BEQL 8$ ;8$ 05 13 0008D CMPL R0, #4 ;R0, #4 04 50 D1 0008F BNEQ 10$ ;10$ 3F 12 00092 8$: MOVZBL G^U.11+59, R11 ;U.11+59, R11 2286 5B 00000000' 00 9A 00094 MOVL G^U.11+76, R0 ;U.11+76, R0 50 00000000' 00 D0 0009B MOVZBL G^U.11+60, R10 ;U.11+60, R10 2287 5A 00000000' 00 9A 000A2 MOVL G^U.11+80, R9 ;U.11+80, R9 59 00000000' 00 D0 000A9 MOVZBL #132, R8 ;#132, R8 2288 58 84 8F 9A 000B0 MOVAB G^FILE_NAME, R6 ;FILE_NAME, R6 56 00000000G 00 9E 000B4 MOVC5 R11, (R0), #0, R8, (R6) ;R11, (R0), #0, R8, (R6) 60 5B 2C 000BB ; 58 00 000BE ; 66 000C0 BGEQ 9$ ;9$ 0C 18 000C1 ADDL2 R11, R6 ;R11, R6 56 5B C0 000C3 SUBL2 R11, R8 ;R11, R8 58 5B C2 000C6 MOVC5 R10, (R9), #0, R8, (R6) ;R10, (R9), #0, R8, (R6) 69 5A 2C 000C9 ; 58 00 000CC ; 66 000CE 9$: ADDW3 R10, R11, R7 ;R10, R11, SIZE 2289 5B 5A A1 000CF ; 57 000D2 10$: CMPW R7, #132 ;SIZE, #132 2293 0084 8F 57 B1 000D3 BLEQU 11$ ;11$ 0A 1B 000D8 MOVZBL #132, G^FILE_SIZE ;#132, FILE_SIZE 00000000G 00 84 8F 9A 000DA BRB 12$ ;12$ 07 11 000E2 11$: MOVZWL R7, G^FILE_SIZE ;SIZE, FILE_SIZE 00000000G 00 57 3C 000E4 12$: BLBS G^CONNECT_FLAG, 13$ ;CONNECT_FLAG, 13$ 2298 44 00000000G 00 E8 000EB BLBC G^TY_FIL, 13$ ;TY_FIL, 13$ 3D 00000000G 00 E9 000F2 PUSHAB G^P.AAD ;P.AAD 2301 00000000' 00 9F 000F9 CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 000FF MOVL G^U.11+4, R0 ;U.11+4, R0 2302 50 00000000' 00 D0 00106 MOVZBL G^U.11+3, R1 ;U.11+3, R1 51 00000000' 00 9A 0010D PUSHAB (R1)[R0] ;(R1)[R0] 6140 9F 00114 CLRL @(SP)+ ;@(SP)+ 9E D4 00117 PUSHL R0 ;R0 2303 50 DD 00119 CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 0011B PUSHAB G^P.AAE ;P.AAE 2304 00000000' 00 9F 00122 CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 00128 CALLS #0, G^TT_OUTPUT ;#0, TT_OUTPUT 2305 00000000G 00 00 FB 0012F 13$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2308 50 00000000G 8F D0 00136 RET ; 04 0013D ; Routine Size: 318 bytes, Routine Base: $CODE$ + 0CF1 ; 2310 1 ; 2311 1 %SBTTL 'LOG_OPEN - Open a log file' ; 2312 1 ; 2313 1 GLOBAL ROUTINE LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB) = ; 2314 1 ; 2315 1 !++ ; 2316 1 ! FUNCTIONAL DESCRIPTION: ; 2317 1 ! ; 2318 1 ! CALLING SEQUENCE: ; 2319 1 ! ; 2320 1 ! STATUS = LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB) ; 2321 1 ! ; 2322 1 ! INPUT PARAMETERS: ; 2323 1 ! ; 2324 1 ! LOG_DESC - Address of descriptor for file name to be opened ; 2325 1 ! ; 2326 1 ! LOG_FAB - Address of FAB for file ; 2327 1 ! ; 2328 1 ! LOG_RAB - Address of RAB for file ; 2329 1 ! ; 2330 1 ! IMPLICIT INPUTS: ; 2331 1 ! ; 2332 1 ! None. ; 2333 1 ! ; 2334 1 ! OUPTUT PARAMETERS: ; 2335 1 ! ; 2336 1 ! LOG_FAB and LOG_RAB updated. ; 2337 1 ! ; 2338 1 ! IMPLICIT OUTPUTS: ; 2339 1 ! ; 2340 1 ! None. ; 2341 1 ! ; 2342 1 ! COMPLETION CODES: ; 2343 1 ! ; 2344 1 ! Error code or true. ; 2345 1 ! ; 2346 1 ! SIDE EFFECTS: ; 2347 1 ! ; 2348 1 ! None. ; 2349 1 ! ; 2350 1 !-- ; 2351 1 ; 2352 2 BEGIN ; 2353 2 ! ; 2354 2 ! Completion codes returned: ; 2355 2 ! ; 2356 2 EXTERNAL LITERAL ; 2357 2 KER_NORMAL, ! Normal return ; 2358 2 KER_RMS32; ! RMS-32 error ; 2359 2 ; 2360 2 MAP ; 2361 2 LOG_DESC : REF BLOCK [8, BYTE], ! Name descriptor ; 2362 2 LOG_FAB : REF $FAB_DECL, ! FAB for file ; 2363 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2364 2 ; 2365 2 LOCAL ; 2366 2 STATUS, ! Random status values ; 2367 2 REC_ADDRESS, ! Address of record buffer ; 2368 2 REC_SIZE; ! Size of record buffer ; 2369 2 ; 2370 2 ! ; 2371 2 ! Get memory for records ; 2372 2 ! ; 2373 2 REC_SIZE = LOG_BUFF_SIZE; ; 2374 2 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 2375 2 ; 2376 2 IF NOT .STATUS ; 2377 2 THEN ; 2378 3 BEGIN ; 2379 3 LIB$SIGNAL (.STATUS); ; 2380 3 RETURN .STATUS; ; 2381 2 END; ; 2382 2 ; 2383 2 ! ; 2384 2 ! Initialize the FAB and RAB ; 2385 2 ! ; P 2386 2 $FAB_INIT (FAB = .LOG_FAB, FAC = PUT, FNA = .LOG_DESC [DSC$A_POINTER], ; P 2387 2 FNS = .LOG_DESC [DSC$W_LENGTH], FOP = (MXV, CBT, SQO, TEF), ORG = SEQ, RFM = VAR, ; 2388 2 RAT = CR, CTX = 0, DNA = UPLIT (%ASCII'.LOG'), DNS = 4); ; 2389 2 STATUS = $CREATE (FAB = .LOG_FAB); ; 2390 2 ; 2391 2 IF NOT .STATUS ; 2392 2 THEN ; 2393 3 BEGIN ; 2394 3 FILE_ERROR (.STATUS); ; 2395 3 LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ! Dump record buffer ; 2396 3 RETURN KER_RMS32; ; 2397 2 END; ; 2398 2 ; P 2399 2 $RAB_INIT (RAB = .LOG_RAB, FAB = .LOG_FAB, RAC = SEQ, RBF = .REC_ADDRESS, ; 2400 2 RSZ = .REC_SIZE, UBF = .REC_ADDRESS, USZ = .REC_SIZE, ROP = <NLK, WAT>, CTX = 0); ; 2401 2 STATUS = $CONNECT (RAB = .LOG_RAB); ; 2402 2 ; 2403 2 IF NOT .STATUS ; 2404 2 THEN ; 2405 3 BEGIN ; 2406 3 FILE_ERROR (.STATUS); ; 2407 3 LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ; 2408 3 $CLOSE (FAB = .LOG_FAB); ; 2409 3 RETURN KER_RMS32; ; 2410 3 END ; 2411 2 ELSE ; 2412 2 RETURN .STATUS; ; 2413 2 ; 2414 1 END; ! End of LOG_OPEN .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAF: .ASCII \.LOG\ ; 47 4F 4C 2E 00028 .PSECT $CODE$,NOWRT,2 .ENTRY LOG_OPEN, ^M<R2,R3,R4,R5,R6,R7,- ;LOG_OPEN, Save R2,R3,R4,R5,R6,R7,- 2313 07FC 00000 R8,R9,R10> ;R8,R9,R10 MOVAB G^LIB$FREE_VM, R10 ;LIB$FREE_VM, R10 5A 00000000G 00 9E 00002 MOVAB G^U.6, R9 ;U.6, R9 59 00000000V 00 9E 00009 SUBL2 #8, SP ;#8, SP 5E 08 C2 00010 MOVZWL #256, 4(SP) ;#256, REC_SIZE 2373 04 AE 0100 8F 3C 00013 PUSHL SP ;SP 2374 5E DD 00019 PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 0001B CALLS #2, G^LIB$GET_VM ;#2, LIB$GET_VM 00000000G 00 02 FB 0001E MOVL R0, R8 ;R0, STATUS 58 50 D0 00025 BLBS R8, 1$ ;STATUS, 1$ 2376 0C 58 E8 00028 PUSHL R8 ;STATUS 2379 58 DD 0002B CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 0002D BRW 4$ ;4$ 2380 00BD 31 00034 1$: MOVL 8(AP), R7 ;LOG_FAB, R7 2388 57 08 AC D0 00037 MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, (R7) 6E 00 2C 0003B ; 0050 8F 00 0003E ; 67 00042 MOVW #20483, (R7) ;#20483, (R7) 67 5003 8F B0 00043 MOVL #270532674, 4(R7) ;#270532674, 4(R7) 04 A7 10200042 8F D0 00048 MOVB #1, 22(R7) ;#1, 22(R7) 16 A7 01 90 00050 MOVW #512, 29(R7) ;#512, 29(R7) 1D A7 0200 8F B0 00054 MOVB #2, 31(R7) ;#2, 31(R7) 1F A7 02 90 0005A MOVL 4(AP), R0 ;LOG_DESC, R0 50 04 AC D0 0005E MOVL 4(R0), 44(R7) ;4(R0), 44(R7) 2C A7 04 A0 D0 00062 MOVAB G^P.AAF, 48(R7) ;P.AAF, 48(R7) 30 A7 00000000' 00 9E 00067 MOVB (R0), 52(R7) ;(R0), 52(R7) 34 A7 60 90 0006F MOVB #4, 53(R7) ;#4, 53(R7) 35 A7 04 90 00073 PUSHL R7 ;R7 2389 57 DD 00077 CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE 00000000G 00 01 FB 00079 MOVL R0, R8 ;R0, STATUS 58 50 D0 00080 BLBS R8, 2$ ;STATUS, 2$ 2391 0F 58 E8 00083 PUSHL R8 ;STATUS 2394 58 DD 00086 CALLS #1, (R9) ;#1, FILE_ERROR 69 01 FB 00088 PUSHL SP ;SP 2395 5E DD 0008B PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 0008D CALLS #2, (R10) ;#2, LIB$FREE_VM 6A 02 FB 00090 BRB 3$ ;3$ 2396 57 11 00093 2$: MOVL 12(AP), R6 ;LOG_RAB, R6 2400 56 0C AC D0 00095 MOVC5 #0, (SP), #0, #68, (R6) ;#0, (SP), #0, #68, (R6) 6E 00 2C 00099 ; 0044 8F 00 0009C ; 66 000A0 MOVW #17409, (R6) ;#17409, (R6) 66 4401 8F B0 000A1 MOVL #1179648, 4(R6) ;#1179648, 4(R6) 04 A6 00120000 8F D0 000A6 CLRB 30(R6) ;30(R6) 1E A6 94 000AE MOVW 4(SP), 32(R6) ;REC_SIZE, 32(R6) 20 A6 04 AE B0 000B1 MOVW 4(SP), 34(R6) ;REC_SIZE, 34(R6) 22 A6 04 AE B0 000B6 MOVL (SP), 36(R6) ;REC_ADDRESS, 36(R6) 24 A6 6E D0 000BB MOVL (SP), 40(R6) ;REC_ADDRESS, 40(R6) 28 A6 6E D0 000BF MOVL R7, 60(R6) ;R7, 60(R6) 3C A6 57 D0 000C3 PUSHL R6 ;R6 2401 56 DD 000C7 CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT 00000000G 00 01 FB 000C9 MOVL R0, R8 ;R0, STATUS 58 50 D0 000D0 BLBS R8, 4$ ;STATUS, 4$ 2403 1E 58 E8 000D3 PUSHL R8 ;STATUS 2406 58 DD 000D6 CALLS #1, (R9) ;#1, FILE_ERROR 69 01 FB 000D8 PUSHL SP ;SP 2407 5E DD 000DB PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 000DD CALLS #2, (R10) ;#2, LIB$FREE_VM 6A 02 FB 000E0 PUSHL R7 ;R7 2408 57 DD 000E3 CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE 00000000G 00 01 FB 000E5 3$: MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 2409 50 00000000G 8F D0 000EC RET ; 04 000F3 4$: MOVL R8, R0 ;STATUS, R0 50 58 D0 000F4 RET ; 2412 04 000F7 ; Routine Size: 248 bytes, Routine Base: $CODE$ + 0E2F ; 2415 1 ; 2416 1 %SBTTL 'LOG_CLOSE - Close a log file' ; 2417 1 ; 2418 1 GLOBAL ROUTINE LOG_CLOSE (LOG_FAB, LOG_RAB) = ; 2419 1 ; 2420 1 !++ ; 2421 1 ! FUNCTIONAL DESCRIPTION: ; 2422 1 ! ; 2423 1 ! This routine will close an open log file. It will also ensure that ; 2424 1 !the last buffer gets dumped. ; 2425 1 ! ; 2426 1 ! CALLING SEQUENCE: ; 2427 1 ! ; 2428 1 ! STATUS = LOG_CLOSE (LOG_FAB, LOG_RAB); ; 2429 1 ! ; 2430 1 ! INPUT PARAMETERS: ; 2431 1 ! ; 2432 1 ! LOG_FAB - Address of log file FAB ; 2433 1 ! ; 2434 1 ! LOG_RAB - Address of log file RAB ; 2435 1 ! ; 2436 1 ! IMPLICIT INPUTS: ; 2437 1 ! ; 2438 1 ! None. ; 2439 1 ! ; 2440 1 ! OUPTUT PARAMETERS: ; 2441 1 ! ; 2442 1 ! None. ; 2443 1 ! ; 2444 1 ! IMPLICIT OUTPUTS: ; 2445 1 ! ; 2446 1 ! None. ; 2447 1 ! ; 2448 1 ! COMPLETION CODES: ; 2449 1 ! ; 2450 1 ! Resulting status. ; 2451 1 ! ; 2452 1 ! SIDE EFFECTS: ; 2453 1 ! ; 2454 1 ! None. ; 2455 1 ! ; 2456 1 !-- ; 2457 1 ; 2458 2 BEGIN ; 2459 2 ! ; 2460 2 ! Completion codes returned: ; 2461 2 ! ; 2462 2 EXTERNAL LITERAL ; 2463 2 KER_RMS32; ! RMS-32 error ; 2464 2 ; 2465 2 MAP ; 2466 2 LOG_FAB : REF $FAB_DECL, ! FAB for log file ; 2467 2 LOG_RAB : REF $RAB_DECL; ! RAB for log file ; 2468 2 ; 2469 2 LOCAL ; 2470 2 STATUS, ! Random status values ; 2471 2 REC_ADDRESS, ! Address of record buffer ; 2472 2 REC_SIZE; ! Size of record buffer ; 2473 2 ; 2474 2 ! ; 2475 2 ! First write out any outstanding data ; 2476 2 ! ; 2477 2 ; 2478 2 IF .LOG_RAB [RAB$L_CTX] GTR 0 THEN LOG_PUT (.LOG_RAB); ! Dump current buffer ; 2479 2 ; 2480 2 ! ; 2481 2 ! Return the buffer ; 2482 2 ! ; 2483 2 REC_SIZE = LOG_BUFF_SIZE; ! Get size of buffer ; 2484 2 REC_ADDRESS = .LOG_RAB [RAB$L_RBF]; ! And address ; 2485 2 LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ; 2486 2 ! ; 2487 2 ! Now disconnect the RAB ; 2488 2 ! ; 2489 2 STATUS = $DISCONNECT (RAB = .LOG_RAB); ; 2490 2 ; 2491 2 IF NOT .STATUS ; 2492 2 THEN ; 2493 3 BEGIN ; 2494 3 FILE_ERROR (.STATUS); ; 2495 3 RETURN KER_RMS32; ; 2496 2 END; ; 2497 2 ; 2498 2 ! ; 2499 2 ! Now we can close the file ; 2500 2 ! ; 2501 2 STATUS = $CLOSE (FAB = .LOG_FAB); ; 2502 2 ; 2503 2 IF NOT .STATUS THEN FILE_ERROR (.STATUS); ; 2504 2 ; 2505 2 ! ; 2506 2 ! And return the result ; 2507 2 ! ; 2508 2 RETURN .STATUS; ; 2509 1 END; ! End of LOG_CLOSE .EXTRN SYS$DISCONNECT .ENTRY LOG_CLOSE, ^M<R2,R3> ;LOG_CLOSE, Save R2,R3 2418 000C 00000 MOVAB G^U.6, R3 ;U.6, R3 53 00000000V 00 9E 00002 SUBL2 #8, SP ;#8, SP 5E 08 C2 00009 MOVL 8(AP), R2 ;LOG_RAB, R2 2478 52 08 AC D0 0000C TSTL 24(R2) ;24(R2) 18 A2 D5 00010 BLEQ 1$ ;1$ 09 15 00013 PUSHL R2 ;R2 52 DD 00015 CALLS #1, G^U.1 ;#1, U.1 00000000V 00 01 FB 00017 1$: MOVZWL #256, 4(SP) ;#256, REC_SIZE 2483 04 AE 0100 8F 3C 0001E MOVL 40(R2), (SP) ;40(R2), REC_ADDRESS 2484 6E 28 A2 D0 00024 PUSHL SP ;SP 2485 5E DD 00028 PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 0002A CALLS #2, G^LIB$FREE_VM ;#2, LIB$FREE_VM 00000000G 00 02 FB 0002D PUSHL R2 ;R2 2489 52 DD 00034 CALLS #1, G^SYS$DISCONNECT ;#1, SYS$DISCONNECT 00000000G 00 01 FB 00036 MOVL R0, R2 ;R0, STATUS 52 50 D0 0003D BLBS R2, 2$ ;STATUS, 2$ 2491 0D 52 E8 00040 PUSHL R2 ;STATUS 2494 52 DD 00043 CALLS #1, (R3) ;#1, FILE_ERROR 63 01 FB 00045 MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 2495 50 00000000G 8F D0 00048 RET ; 04 0004F 2$: PUSHL 4(AP) ;LOG_FAB 2501 04 AC DD 00050 CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE 00000000G 00 01 FB 00053 MOVL R0, R2 ;R0, STATUS 52 50 D0 0005A BLBS R2, 3$ ;STATUS, 3$ 2503 05 52 E8 0005D PUSHL R2 ;STATUS 52 DD 00060 CALLS #1, (R3) ;#1, FILE_ERROR 63 01 FB 00062 3$: MOVL R2, R0 ;STATUS, R0 2508 50 52 D0 00065 RET ; 04 00068 ; Routine Size: 105 bytes, Routine Base: $CODE$ + 0F27 ; 2510 1 ; 2511 1 %SBTTL 'LOG_CHAR - Log a character to a file' ; 2512 1 ; 2513 1 GLOBAL ROUTINE LOG_CHAR (CH, LOG_RAB) = ; 2514 1 ; 2515 1 !++ ; 2516 1 ! FUNCTIONAL DESCRIPTION: ; 2517 1 ! ; 2518 1 ! This routine will write one character to an open log file. ; 2519 1 !If the buffer becomes filled, it will dump it. It will also ; 2520 1 !dump the buffer if a carriage return line feed is seen. ; 2521 1 ! ; 2522 1 ! CALLING SEQUENCE: ; 2523 1 ! ; 2524 1 ! STATUS = LOG_CHAR (.CH, LOG_RAB); ; 2525 1 ! ; 2526 1 ! INPUT PARAMETERS: ; 2527 1 ! ; 2528 1 ! CH - The character to write to the file. ; 2529 1 ! ; 2530 1 ! LOG_RAB - The address of the log file RAB. ; 2531 1 ! ; 2532 1 ! IMPLICIT INPUTS: ; 2533 1 ! ; 2534 1 ! None. ; 2535 1 ! ; 2536 1 ! OUPTUT PARAMETERS: ; 2537 1 ! ; 2538 1 ! None. ; 2539 1 ! ; 2540 1 ! IMPLICIT OUTPUTS: ; 2541 1 ! ; 2542 1 ! None. ; 2543 1 ! ; 2544 1 ! COMPLETION CODES: ; 2545 1 ! ; 2546 1 ! Any error returned by LOG_PUT, else TRUE. ; 2547 1 ! ; 2548 1 ! SIDE EFFECTS: ; 2549 1 ! ; 2550 1 ! None. ; 2551 1 ! ; 2552 1 !-- ; 2553 1 ; 2554 2 BEGIN ; 2555 2 ! ; 2556 2 ! Completion codes returned: ; 2557 2 ! ; 2558 2 EXTERNAL LITERAL ; 2559 2 KER_NORMAL; ! Normal return ; 2560 2 ; 2561 2 MAP ; 2562 2 LOG_RAB : REF $RAB_DECL; ! Log file RAB ; 2563 2 ; 2564 2 LOCAL ; 2565 2 STATUS; ! Random status value ; 2566 2 ; 2567 2 ! ; 2568 2 ! If this character is a line feed, and previous was a carriage return, then ; 2569 2 ! dump the buffer and return. ; 2570 2 ! ; 2571 2 ; 2572 2 IF .CH EQL CHR_LFD ; 2573 2 THEN ; 2574 3 BEGIN ; 2575 3 ! ; 2576 3 ! If we seem to have overfilled the buffer, that is because we saw a CR ; 2577 3 ! last, and had no place to put it. Just reset the size and dump the buffer. ; 2578 3 ! ; 2579 3 ; 2580 3 IF .LOG_RAB [RAB$L_CTX] GTR LOG_BUFF_SIZE ; 2581 3 THEN ; 2582 4 BEGIN ; 2583 4 LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE; ; 2584 4 RETURN LOG_PUT (.LOG_RAB); ; 2585 3 END; ; 2586 3 ; 2587 3 ! ; 2588 3 ! If last character in buffer is a CR, then dump buffer without the CR ; 2589 3 ! ; 2590 3 ; 2591 3 IF CH$RCHAR (CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX] - 1)) EQL CHR_CRT ; 2592 3 THEN ; 2593 4 BEGIN ; 2594 4 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] - 1; ; 2595 4 RETURN LOG_PUT (.LOG_RAB); ; 2596 3 END; ; 2597 3 ; 2598 2 END; ; 2599 2 ; 2600 2 ! ; 2601 2 ! Don't need to dump buffer because of end of line problems. Check if ; 2602 2 ! the buffer is full. ; 2603 2 ! ; 2604 2 ; 2605 2 IF .LOG_RAB [RAB$L_CTX] GEQ LOG_BUFF_SIZE ; 2606 2 THEN ; 2607 3 BEGIN ; 2608 3 ! ; 2609 3 ! If character we want to store is a carriage return, then just count it and ; 2610 3 ! don't dump the buffer yet. ; 2611 3 ! ; 2612 3 ; 2613 3 IF .CH EQL CHR_CRT ; 2614 3 THEN ; 2615 4 BEGIN ; 2616 4 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1; ; 2617 4 RETURN KER_NORMAL; ; 2618 3 END; ; 2619 3 ; 2620 3 ! ; 2621 3 ! We must dump the buffer to make room for more characters ; 2622 3 ! ; 2623 3 STATUS = LOG_PUT (.LOG_RAB); ; 2624 3 ; 2625 3 IF NOT .STATUS THEN RETURN .STATUS; ; 2626 3 ; 2627 2 END; ; 2628 2 ; 2629 2 ! ; 2630 2 ! Here when we have some room to store the character ; 2631 2 ! ; 2632 2 CH$WCHAR (.CH, CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX])); ; 2633 2 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1; ; 2634 2 RETURN KER_NORMAL; ; 2635 1 END; ! End of LOG_CHAR .ENTRY LOG_CHAR, ^M<R2,R3> ;LOG_CHAR, Save R2,R3 2513 000C 00000 MOVAB G^U.1, R3 ;U.1, R3 53 00000000V 00 9E 00002 CMPL 4(AP), #10 ;CH, #10 2572 0A 04 AC D1 00009 BNEQ 3$ ;3$ 2B 12 0000D MOVL 8(AP), R2 ;LOG_RAB, R2 2580 52 08 AC D0 0000F CMPL 24(R2), #256 ;24(R2), #256 00000100 8F 18 A2 D1 00013 BLEQ 1$ ;1$ 08 15 0001B MOVZWL #256, 24(R2) ;#256, 24(R2) 2583 18 A2 0100 8F 3C 0001D BRB 2$ ;2$ 2584 0F 11 00023 1$: ADDL3 24(R2), 40(R2), R0 ;24(R2), 40(R2), R0 2591 28 A2 18 A2 C1 00025 ; 50 0002A CMPB -1(R0), #13 ;-1(R0), #13 0D FF A0 91 0002B BNEQ 3$ ;3$ 09 12 0002F DECL 24(R2) ;24(R2) 2594 18 A2 D7 00031 2$: PUSHL R2 ;R2 2595 52 DD 00034 CALLS #1, (R3) ;#1, LOG_PUT 63 01 FB 00036 RET ; 04 00039 3$: MOVL 8(AP), R2 ;LOG_RAB, R2 2605 52 08 AC D0 0003A CMPL 24(R2), #256 ;24(R2), #256 00000100 8F 18 A2 D1 0003E BLSS 4$ ;4$ 0E 19 00046 CMPL 4(AP), #13 ;CH, #13 2613 0D 04 AC D1 00048 BEQL 5$ ;5$ 12 13 0004C PUSHL R2 ;R2 2623 52 DD 0004E CALLS #1, (R3) ;#1, LOG_PUT 63 01 FB 00050 BLBC R0, 6$ ;STATUS, 6$ 2625 14 50 E9 00053 4$: ADDL3 24(R2), 40(R2), R0 ;24(R2), 40(R2), R0 2632 28 A2 18 A2 C1 00056 ; 50 0005B MOVB 4(AP), (R0) ;CH, (R0) 60 04 AC 90 0005C 5$: INCL 24(R2) ;24(R2) 2633 18 A2 D6 00060 MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2634 50 00000000G 8F D0 00063 6$: RET ; 04 0006A ; Routine Size: 107 bytes, Routine Base: $CODE$ + 0F90 ; 2636 1 ; 2637 1 %SBTTL 'LOG_LINE - Log a line to a log file' ; 2638 1 ; 2639 1 GLOBAL ROUTINE LOG_LINE (LINE_DESC, LOG_RAB) = ; 2640 1 ; 2641 1 !++ ; 2642 1 ! FUNCTIONAL DESCRIPTION: ; 2643 1 ! ; 2644 1 ! This routine will write an entire line to a log file. And previously ; 2645 1 ! written characters will be dumped first. ; 2646 1 ! ; 2647 1 ! CALLING SEQUENCE: ; 2648 1 ! ; 2649 1 ! STATUS = LOG_LINE (LINE_DESC, LOG_RAB); ; 2650 1 ! ; 2651 1 ! INPUT PARAMETERS: ; 2652 1 ! ; 2653 1 ! LINE_DESC - Address of descriptor for string to be written ; 2654 1 ! ; 2655 1 ! LOG_RAB - RAB for log file ; 2656 1 ! ; 2657 1 ! IMPLICIT INPUTS: ; 2658 1 ! ; 2659 1 ! None. ; 2660 1 ! ; 2661 1 ! OUPTUT PARAMETERS: ; 2662 1 ! ; 2663 1 ! None. ; 2664 1 ! ; 2665 1 ! IMPLICIT OUTPUTS: ; 2666 1 ! ; 2667 1 ! None. ; 2668 1 ! ; 2669 1 ! COMPLETION CODES: ; 2670 1 ! ; 2671 1 ! KER_NORMAL or LOG_PUT error code. ; 2672 1 ! ; 2673 1 ! SIDE EFFECTS: ; 2674 1 ! ; 2675 1 ! None. ; 2676 1 ! ; 2677 1 !-- ; 2678 1 ; 2679 2 BEGIN ; 2680 2 ; 2681 2 MAP ; 2682 2 LINE_DESC : REF BLOCK [8, BYTE], ! Descriptor for string ; 2683 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2684 2 ; 2685 2 LOCAL ; 2686 2 STATUS; ! Random status value ; 2687 2 ; 2688 2 ! ; 2689 2 ! First check if anything is already in the buffer ; 2690 2 ! ; 2691 2 ; 2692 2 IF .LOG_RAB [RAB$L_CTX] GTR 0 ; 2693 2 THEN ; 2694 3 BEGIN ; 2695 3 STATUS = LOG_PUT (.LOG_RAB); ! Yes, write it out ; 2696 3 ; 2697 3 IF NOT .STATUS THEN RETURN .STATUS; ! Pass back any errors ; 2698 3 ; 2699 2 END; ; 2700 2 ; 2701 2 ! ; 2702 2 ! Copy the data to the buffer ; 2703 2 ! ; 2704 2 CH$COPY (.LINE_DESC [DSC$W_LENGTH], CH$PTR (.LINE_DESC [DSC$A_POINTER]), CHR_NUL, ; 2705 2 LOG_BUFF_SIZE, CH$PTR (.LOG_RAB [RAB$L_RBF])); ; 2706 2 ; 2707 2 IF .LINE_DESC [DSC$W_LENGTH] GTR LOG_BUFF_SIZE ; 2708 2 THEN ; 2709 2 LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE ; 2710 2 ELSE ; 2711 2 LOG_RAB [RAB$L_CTX] = .LINE_DESC [DSC$W_LENGTH]; ; 2712 2 ; 2713 2 ! ; 2714 2 ! Now just dump the buffer ; 2715 2 ! ; 2716 2 RETURN LOG_PUT (.LOG_RAB); ; 2717 1 END; ! End of LOG_LINE .ENTRY LOG_LINE, ^M<R2,R3,R4,R5,R6,R7,- ;LOG_LINE, Save R2,R3,R4,R5,R6,R7,R8 2639 01FC 00000 R8> ; MOVAB G^U.1, R8 ;U.1, R8 58 00000000V 00 9E 00002 MOVL 8(AP), R6 ;LOG_RAB, R6 2692 56 08 AC D0 00009 TSTL 24(R6) ;24(R6) 18 A6 D5 0000D BLEQ 1$ ;1$ 08 15 00010 PUSHL R6 ;R6 2695 56 DD 00012 CALLS #1, (R8) ;#1, LOG_PUT 68 01 FB 00014 BLBC R0, 4$ ;STATUS, 4$ 2697 26 50 E9 00017 1$: MOVL 4(AP), R7 ;LINE_DESC, R7 2704 57 04 AC D0 0001A MOVC5 (R7), @4(R7), #0, #256, @40(R6) ;(R7), @4(R7), #0, #256, @40(R6) 2705 04 B7 67 2C 0001E ; 0100 8F 00 00022 ; 28 B6 00026 CMPW (R7), #256 ;(R7), #256 2707 0100 8F 67 B1 00028 BLEQU 2$ ;2$ 08 1B 0002D MOVZWL #256, 24(R6) ;#256, 24(R6) 2709 18 A6 0100 8F 3C 0002F BRB 3$ ;3$ 04 11 00035 2$: MOVZWL (R7), 24(R6) ;(R7), 24(R6) 2711 18 A6 67 3C 00037 3$: PUSHL R6 ;R6 2716 56 DD 0003B CALLS #1, (R8) ;#1, LOG_PUT 68 01 FB 0003D 4$: RET ; 04 00040 ; Routine Size: 65 bytes, Routine Base: $CODE$ + 0FFB ; 2718 1 %SBTTL 'LOG_FAOL - Log an FAO string to the log file' ; 2719 1 ; 2720 1 GLOBAL ROUTINE LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB) = ; 2721 1 ; 2722 1 !++ ; 2723 1 ! FUNCTIONAL DESCRIPTION: ; 2724 1 ! ; 2725 1 ! This routine will write an FAOL string to the output file. ; 2726 1 ! ; 2727 1 ! CALLING SEQUENCE: ; 2728 1 ! ; 2729 1 ! STATUS = LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB); ; 2730 1 ! ; 2731 1 ! INPUT PARAMETERS: ; 2732 1 ! ; 2733 1 ! FAOL_DESC - Address of descriptor for string to be written ; 2734 1 ! ; 2735 1 ! FAOL_PARAMS - Parameter list for FAOL call ; 2736 1 ! ; 2737 1 ! LOG_RAB - RAB for log file ; 2738 1 ! ; 2739 1 ! IMPLICIT INPUTS: ; 2740 1 ! ; 2741 1 ! None. ; 2742 1 ! ; 2743 1 ! OUPTUT PARAMETERS: ; 2744 1 ! ; 2745 1 ! None. ; 2746 1 ! ; 2747 1 ! IMPLICIT OUTPUTS: ; 2748 1 ! ; 2749 1 ! None. ; 2750 1 ! ; 2751 1 ! COMPLETION CODES: ; 2752 1 ! ; 2753 1 ! KER_NORMAL or $FAOL or LOG_PUT error code. ; 2754 1 ! ; 2755 1 ! SIDE EFFECTS: ; 2756 1 ! ; 2757 1 ! None. ; 2758 1 ! ; 2759 1 !-- ; 2760 1 ; 2761 2 BEGIN ; 2762 2 ! ; 2763 2 ! Completion codes returned: ; 2764 2 ! ; 2765 2 EXTERNAL LITERAL ; 2766 2 KER_NORMAL; ! Normal return ; 2767 2 ; 2768 2 MAP ; 2769 2 FAOL_DESC : REF BLOCK [8, BYTE], ! Descriptor for string ; 2770 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2771 2 ; 2772 2 LITERAL ; 2773 2 FAOL_BUFSIZ = 256; ! Length of buffer ; 2774 2 ; 2775 2 LOCAL ; 2776 2 FAOL_BUFFER : VECTOR [FAOL_BUFSIZ, BYTE], ! Buffer for FAOL output ; 2777 2 FAOL_BUF_DESC : BLOCK [8, BYTE], ! Descriptor for buffer ; 2778 2 STATUS; ! Random status value ; 2779 2 ; 2780 2 ! ; 2781 2 ! Initialize descriptor for buffer ; 2782 2 ! ; 2783 2 FAOL_BUF_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 2784 2 FAOL_BUF_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 2785 2 FAOL_BUF_DESC [DSC$A_POINTER] = FAOL_BUFFER; ; 2786 2 FAOL_BUF_DESC [DSC$W_LENGTH] = FAOL_BUFSIZ; ; 2787 2 ! ; 2788 2 ! Now do the FAOL to generate the full text ; 2789 2 ! ; P 2790 2 STATUS = $FAOL (CTRSTR = .FAOL_DESC, OUTBUF = FAOL_BUF_DESC, ; 2791 2 OUTLEN = FAOL_BUF_DESC [DSC$W_LENGTH], PRMLST = .FAOL_PARAMS); ; 2792 2 IF NOT .STATUS THEN RETURN .STATUS; ; 2793 2 ! ; 2794 2 ! Dump the text into the file ; 2795 2 ! ; 2796 2 INCR I FROM 1 TO .FAOL_BUF_DESC [DSC$W_LENGTH] DO ; 2797 3 BEGIN ; 2798 3 STATUS = LOG_CHAR ( .FAOL_BUFFER [.I - 1], .LOG_RAB); ; 2799 3 IF NOT .STATUS THEN RETURN .STATUS; ; 2800 2 END; ; 2801 2 ; 2802 2 RETURN KER_NORMAL; ; 2803 2 ; 2804 1 END; ! End of LOG_FAOL .EXTRN SYS$FAOL .ENTRY LOG_FAOL, ^M<R2,R3> ;LOG_FAOL, Save R2,R3 2720 000C 00000 MOVAB -260(SP), SP ;-260(SP), SP 5E FEFC CE 9E 00002 PUSHL #17694976 ;#17694976 2786 010E0100 8F DD 00007 MOVAB 8(SP), 4(SP) ;FAOL_BUFFER, FAOL_BUF_DESC+4 2785 04 AE 08 AE 9E 0000D PUSHL 8(AP) ;FAOL_PARAMS 2791 08 AC DD 00012 PUSHAB 4(SP) ;FAOL_BUF_DESC 04 AE 9F 00015 PUSHAB 8(SP) ;FAOL_BUF_DESC 08 AE 9F 00018 PUSHL 4(AP) ;FAOL_DESC 04 AC DD 0001B CALLS #4, G^SYS$FAOL ;#4, SYS$FAOL 00000000G 00 04 FB 0001E BLBC R0, 3$ ;STATUS, 3$ 2792 22 50 E9 00025 MOVZWL (SP), R3 ;FAOL_BUF_DESC, R3 2796 53 6E 3C 00028 CLRL R2 ;I 52 D4 0002B BRB 2$ ;2$ 10 11 0002D 1$: PUSHL 12(AP) ;LOG_RAB 2798 0C AC DD 0002F MOVZBL 11(SP)[R2], -(SP) ;FAOL_BUFFER-1[I], -(SP) 7E 0B AE42 9A 00032 CALLS #2, W^LOG_CHAR ;#2, LOG_CHAR FF18 CF 02 FB 00037 BLBC R0, 3$ ;STATUS, 3$ 2799 0B 50 E9 0003C 2$: AOBLEQ R3, R2, 1$ ;R3, I, 1$ 2796 52 53 F3 0003F ; EC 00042 MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2802 50 00000000G 8F D0 00043 3$: RET ; 04 0004A ; Routine Size: 75 bytes, Routine Base: $CODE$ + 103C ; 2805 1 ; 2806 1 %SBTTL 'LOG_PUT - Write a record buffer for a log file' ; 2807 1 ROUTINE LOG_PUT (LOG_RAB) = ; 2808 1 ; 2809 1 !++ ; 2810 1 ! FUNCTIONAL DESCRIPTION: ; 2811 1 ! ; 2812 1 ! This routine will output one buffer for a log file. ; 2813 1 ! ; 2814 1 ! CALLING SEQUENCE: ; 2815 1 ! ; 2816 1 ! STATUS = LOG_PUT (LOG_RAB); ; 2817 1 ! ; 2818 1 ! INPUT PARAMETERS: ; 2819 1 ! ; 2820 1 ! LOG_RAB - RAB for log file. ; 2821 1 ! ; 2822 1 ! IMPLICIT INPUTS: ; 2823 1 ! ; 2824 1 ! None. ; 2825 1 ! ; 2826 1 ! OUPTUT PARAMETERS: ; 2827 1 ! ; 2828 1 ! None. ; 2829 1 ! ; 2830 1 ! IMPLICIT OUTPUTS: ; 2831 1 ! ; 2832 1 ! None. ; 2833 1 ! ; 2834 1 ! COMPLETION CODES: ; 2835 1 ! ; 2836 1 ! Status value from RMS ; 2837 1 ! ; 2838 1 ! SIDE EFFECTS: ; 2839 1 ! ; 2840 1 ! None. ; 2841 1 ! ; 2842 1 !-- ; 2843 1 ; 2844 2 BEGIN ; 2845 2 ; 2846 2 MAP ; 2847 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2848 2 ; 2849 2 ! ; 2850 2 ! Calculate record size ; 2851 2 ! ; 2852 2 LOG_RAB [RAB$W_RSZ] = .LOG_RAB [RAB$L_CTX]; ; 2853 2 LOG_RAB [RAB$W_USZ] = .LOG_RAB [RAB$W_RSZ]; ; 2854 2 ! ; 2855 2 ! Buffer will be empty when we finish ; 2856 2 ! ; 2857 2 LOG_RAB [RAB$L_CTX] = 0; ; 2858 2 ! ; 2859 2 ! And call RMS to write the buffer ; 2860 2 ! ; 2861 2 RETURN $PUT (RAB = .LOG_RAB); ; 2862 1 END; ! End of LOG_PUT ;LOG_PUT U.1: .WORD ^M<> ;Save nothing 2807 0000 00000 MOVL 4(AP), R0 ;LOG_RAB, R0 2852 50 04 AC D0 00002 MOVW 24(R0), 34(R0) ;24(R0), 34(R0) 22 A0 18 A0 B0 00006 MOVW 34(R0), 32(R0) ;34(R0), 32(R0) 2853 20 A0 22 A0 B0 0000B CLRL 24(R0) ;24(R0) 2857 18 A0 D4 00010 PUSHL R0 ;R0 2861 50 DD 00013 CALLS #1, G^SYS$PUT ;#1, SYS$PUT 00000000G 00 01 FB 00015 RET ; 04 0001C ; Routine Size: 29 bytes, Routine Base: $CODE$ + 1087 ; 2863 1 %SBTTL 'FILE_ERROR - Error processing for all RMS errors' ; 2864 1 ROUTINE FILE_ERROR (STATUS) : NOVALUE = ; 2865 1 ; 2866 1 !++ ; 2867 1 ! FUNCTIONAL DESCRIPTION: ; 2868 1 ! ; 2869 1 ! This routine will process all of the RMS-32 error returns. It will ; 2870 1 ! get the text for the error and then it will issue a KER_ERROR for ; 2871 1 ! the RMS failure. ; 2872 1 ! ; 2873 1 ! CALLING SEQUENCE: ; 2874 1 ! ; 2875 1 ! FILE_ERROR(); ; 2876 1 ! ; 2877 1 ! INPUT PARAMETERS: ; 2878 1 ! ; 2879 1 ! None. ; 2880 1 ! ; 2881 1 ! IMPLICIT INPUTS: ; 2882 1 ! ; 2883 1 ! STATUS - RMS error status. ; 2884 1 ! FILE_NAME - File name and extension. ; 2885 1 ! FILE_SIZE - Size of the thing in FILE_NAME. ; 2886 1 ! ; 2887 1 ! OUTPUT PARAMETERS: ; 2888 1 ! ; 2889 1 ! None. ; 2890 1 ! ; 2891 1 ! IMPLICIT OUTPUTS: ; 2892 1 ! ; 2893 1 ! None. ; 2894 1 ! ; 2895 1 ! COMPLETION CODES: ; 2896 1 ! ; 2897 1 ! None. ; 2898 1 ! ; 2899 1 ! SIDE EFFECTS: ; 2900 1 ! ; 2901 1 ! None. ; 2902 1 ! ; 2903 1 !-- ; 2904 1 ; 2905 2 BEGIN ; 2906 2 ! ; 2907 2 ! KERMIT completion codes ; 2908 2 ! ; 2909 2 EXTERNAL LITERAL ; 2910 2 KER_RMS32; ! RMS-32 error ; 2911 2 ; 2912 2 LOCAL ; 2913 2 ERR_BUFFER : VECTOR [CH$ALLOCATION (MAX_MSG)], ; 2914 2 ERR_DESC : BLOCK [8, BYTE] PRESET ! String descriptor to ; 2915 2 ([DSC$B_CLASS ] = DSC$K_CLASS_S, ! the error buffer ; 2916 2 [DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! standard string ; 2917 2 [DSC$W_LENGTH ] = MAX_MSG, ! descriptor ; 2918 2 [DSC$A_POINTER ] = ERR_BUFFER); ; 2919 2 ; P 2920 2 $GETMSG (MSGID = .STATUS, ; P 2921 2 MSGLEN = ERR_DESC [DSC$W_LENGTH], ; P 2922 2 BUFADR = ERR_DESC, ; 2923 2 FLAGS = 1); ; 2924 2 LIB$SIGNAL (KER_RMS32, 2, ERR_DESC, FILE_DESC); ; 2925 1 END; ! End of FILE_ERROR .EXTRN SYS$GETMSG ;FILE_ERROR U.6: .WORD ^M<> ;Save nothing 2864 0000 00000 MOVAB -1008(SP), SP ;-1008(SP), SP 5E FC10 CE 9E 00002 PUSHL #17695722 ;#17695722 2918 010E03EA 8F DD 00007 MOVAB 8(SP), 4(SP) ;ERR_BUFFER, ERR_DESC+4 04 AE 08 AE 9E 0000D MOVQ #1, -(SP) ;#1, -(SP) 2923 7E 01 7D 00012 PUSHAB 8(SP) ;ERR_DESC 08 AE 9F 00015 PUSHAB 12(SP) ;ERR_DESC 0C AE 9F 00018 PUSHL 4(AP) ;STATUS 04 AC DD 0001B CALLS #5, G^SYS$GETMSG ;#5, SYS$GETMSG 00000000G 00 05 FB 0001E PUSHAB G^FILE_DESC ;FILE_DESC 2924 00000000' 00 9F 00025 PUSHAB 4(SP) ;ERR_DESC 04 AE 9F 0002B PUSHL #2 ;#2 02 DD 0002E PUSHL #KER_RMS32 ;#KER_RMS32 00000000G 8F DD 00030 CALLS #4, G^LIB$SIGNAL ;#4, LIB$SIGNAL 00000000G 00 04 FB 00036 RET ; 2925 04 0003D ; Routine Size: 62 bytes, Routine Base: $CODE$ + 10A4 ; 2926 1 %SBTTL 'End of KERFIL' ; 2927 1 END ! End of module ; 2928 1 ; 2929 0 ELUDOM ; PSECT SUMMARY ; ; Name Bytes Attributes ; ; $OWN$ 857 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $GLOBAL$ 20 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $CODE$ 4322 NOVEC,NOWRT, RD , EXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; . ABS . 0 NOVEC,NOWRT,NORD ,NOEXE,NOSHR, LCL, ABS, CON,NOPIC,ALIGN(0) ; $PLIT$ 44 NOVEC,NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; Library Statistics ; ; -------- Symbols -------- Pages Processing ; File Total Loaded Percent Mapped Time ; ; SYS$COMMON:[SYSLIB]STARLET.L32;2 12540 136 1 721 00:00.4 ; COMMAND QUALIFIERS ; BLIS/LIS/MACH=(ASSEM,UNIQUE)/SOURCE=NOHEAD VMSFIL.BLI ; Compilation Complete .END